SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00012 1 08-24-9413:26ALL ROLF ERNST Buffers in EMS SWAG9408 ┐╛ ù 130 ä▒ {π*************** Generalized file I/O buffering *****************ππThe enclosed TP unit BUFFERS exports a new object BUFFERFILE. Thisπobject allows to define a variable number of buffers with a buffersizeπof up to $FFE0 bytes each. It exports a number of methods to tailorπthe behaviour of the buffer to a specific applications needs - See theπfollowing procedures for details in this area:ππ - SETWRITEBIASπ - SETREADBIASπ - RESETBIASπ - ENABLEINBOUNDπ - ENABLEOUTBOUNDπ - DISABLEINBOUNDπ - DISABLEOUTBOUNDππThe buffers may be allocated in expanded memory if desired. Performanceπwill be somewhat affected by this fact.ππAll methods use the same names as their counterparts in the system unit,πthe there should not be any problem implementing them. The only minorπdifference is the fact, that the READ and WRITE procedures do not acceptπthe optional fourth parameter, which in the system unit will return theπnumber of bytes actually read or written. This was done for performanceπreasons but should be very easy to change.ππThe unit is implemented using some of Turbo Pascals object orientedπlanguage constructs (actually my second step in this area). Some of theπobject oriented stuff is not really very pure code - some access to theπimported data areas is direct, etc. This was done as to achieve some decentπperformance.ππLast but not least a small example on how to use the code:ππProgram Test;πVARπ BF : BufferFile;π L : LongInt;πbeginπ BF.Init(16384,5,True);π BF.SetWriteBias; {Purely optional - may improve performance}π BF.Assign('TEST.FIL');π BF.Rewrite(4);π For L:=1 to 20000 do BF.Write(L,1);π BF.Done;πend.ππThe code is herbey given to the public domain. If you discover any errors,πI would appreciate if you would let me know.ππRolf Ernst 72311,254π}ππUnit Buffers;ππInterFaceπ{*********************************************************************}π{**** Written 1989 by Rolf Ernst ****}π{**** ****}π{**** Code requires Turbo Professional for the expanded memory ****}π{**** access. The procedures used should not take more than a ****}π{**** few lines to reproduce though. ****}π{**** ****}π{**** This code is hereby in the public domain. ****}π{*********************************************************************}ππUses Dos, TpEms;ππTypeπ PtrRec = Recordπ Ofs, Seg : Word;π end;ππ BigBlock = Array[0..1] Of Byte;π BigBlockPtr = ^BigBlock;π BufferPtr = ^BufferDesc;π BufferDesc = objectπ BufferAddr : BigBlockPtr;π EmsHandle : Word;π InEms : Boolean;π Size : Word;π Next : Pointer;π Constructor Init(BufferSize : Word; UseEms : Boolean);π Function Map(Offset, Length : Word) : BigBlockPtr; Virtual;π Destructor Done;π end;ππ FileBufferPtr = ^FileBufferDesc;π FileBufferDesc = Object(BufferDesc)π PosBuffer : LongInt;π BytesUsed : Word;π Initialized : Boolean;π Modified : Boolean;π Constructor Init(BufferSize : Word; UseEms : Boolean);π end;ππ BufferChain = objectπ NumberOfBuffers, BlockSize:Word;π BufferHead, BufferTail : FileBufferPtr;π Procedure Init(BufSize, BufNum : Word; UseEms : Boolean);π Procedure ChainAtEnd(VAR B : FileBufferPtr);π Function BuffersUnUsed:Word;π Procedure Done;π end;ππ BufferFile=Objectπ F : File;π FSize : LongInt;π CurrentPos : LongInt;π RecordSize : Word;π BlockSize : Word;π BufferS : BufferChain;π FlushAll : Boolean;π ReadAll : Boolean;π NoBufferReads : Boolean;π NoBufferWrites : Boolean;π NoBufferIng : Boolean;ππ Procedure Init(BufSize, BufNum:Word; UseEms : Boolean);π {Initialize BufNum buffers for the file, each beingπ Bufsize bytes big - use Expanded memory if UseEms is TRUE}ππ Procedure Flush;π {Write all modified buffers to disk - does not cause DOS toπ flush its buffers}ππ Function FreeBuffer : FileBufferPtr;π {Find an available Buffer - Flush a buffer if necessary}ππ Procedure Read(VAR A; NumRecs : Word);π {Read a record buffered}ππ Procedure DisableOutBound;π {Disable buffering when writing to a file}ππ Procedure Write(VAR A; NumRecs : Word);π {Write a record buffered}ππ Function Eof:Boolean;π {Return true if the current position in the file is at its end}ππ Procedure Seek(NewPos : LongInt);π {Go to a new position in the file}ππ Function FileSize:LongInt;π {Returns the size of a buffered file taking any data in theπ buffers into consideration}ππ Procedure Assign(Name : PathStr);π {Assign a name to a buffered file}ππ Function FilePos:LongInt;π {Returns the current position in a buffered file}ππ Procedure Rewrite(RecSize : Word);π {Create a new file or overwrite an existing one}ππ Procedure Reset(RecSize:Word);π {Open an existing file}ππ Procedure SetWriteBias;π {Indicate, that the majority of the file operations will beπ sequential writes - when a buffer needs to be flushed ALLπ buffers will be flushed}ππ Procedure SetReadBias;π {Indicate, that the majority of the file operations will beπ sequential reads - when a buffer needs to be read ALL buffersπ will be read from disk}ππ Procedure ResetBias;π {Reset file access characteristics to its default values}ππ Procedure DisableInBound;π {Disable buffering when reading from a dataset}ππ Procedure EnableInBound;π {Enable buffering when reading from a dataset}ππ Procedure EnableOutBound;π {Enable buffering when writing to a dataset}ππ Procedure Done;π {Close the file and free all buffers}ππ end;πππImplementationππππProcedure EmsError;πbeginπ Writeln('Severe Error in EMS handler');π readln;π halt;πend;ππFunction MemToEms(BytesIn : LongInt) : Word;πbeginπ MemToEms:=(BytesIn+16383) shr 14;πend;ππProcedure MapBuffer(Handle : Word; BytesInBuffer:Word);πVARπ I : Word;πbeginπ For I:=0 to Pred(MemToEms(BytesInBuffer)) do beginπ If Not MapEmsPage(Handle,i,i) then EmsError;π end;πend;ππProcedure BufferFile.SetWriteBias;πbeginπ FlushAll:=True;π ReadAll:=False;πend;ππProcedure BufferFile.DisableInBound;πbeginπ NoBufferReads:=True;πend;ππProcedure BufferFile.EnableInBound;πbeginπ NoBufferReads:=false;πend;ππProcedure BufferFile.DisableOutBound;πbeginπ Flush;π NoBufferWrites:=True;πend;ππProcedure BufferFile.EnableOutBound;πbeginπ NoBufferWrites:=False;πend;ππProcedure BufferFile.ResetBias;πbeginπ FlushAll:=False;π ReadAll:=False;π NoBufferReads:=False;π NoBufferWrites:=False;πend;ππProcedure BufferFile.SetReadBias;πbeginπ FlushAll:=False;π ReadAll:=True;πend;πππConstructor BufferDesc.Init(BufferSize : Word; UseEms : Boolean);πbeginπ InEms:=UseEms and EmsInstalled andπ (EmsPagesAvail>=MemToEms(Buffersize));π Size:=BufferSize;π If InEms then beginπ EmsHandle:=AllocateEMSPages(MemToEms(Size));π If EmsHandle=EmsErrorCode then EmsError;π BufferAddr:=EmsPageFramePtr;π end else GetMem(BufferAddr,Size);π Next:=Nil;πend;ππFunction BufferDesc.Map(Offset, Length : Word) : BigBlockPtr;πVARπ HighOffset : Word;π MyPointer : BigBlockPTr;πbeginπ MyPointer:=BufferAddr;π Inc(PtrRec(MyPointer).Ofs,Offset);π Map:=MyPointer;π If InEms then beginπ HighOffset:=Pred(Offset+Length);π Offset:=Offset Shr 14;π HighOffset:=HighOffset shr 14;π repeatπ If Not MapEmsPage(EMSHandle,Offset,Offset) then EmsError;π INC(Offset);π until Offset>HighOffset;π end;πend;ππDestructor BufferDesc.Done;πbeginπ IF InEms then beginπ If Not DeallocateEmsHandle(Emshandle) then EmsError;π end else FreeMem(BufferAddr,Size);πend;ππConstructor FileBufferDesc.Init(BufferSize : Word; UseEms : Boolean);πbeginπ BufferDesc.Init(BufferSize, UseEms);π Initialized:=False;π Modified:=False;πend;ππProcedure BufferChain.Init(BufSize, BufNum : Word; UseEms : Boolean);πVARπ I : Word;πbeginπ NumberOfBuffers:=BufNum;π BufferTail:=Nil;π For i:=1 to BufNum do beginπ New(BufferHead,Init(BufSize,UseEms));π BufferHead^.Next:=BufferTail;π BufferTail:=BufferHead;π end;π While BufferTail^.Next<>Nil do BufferTail:=BufferTail^.Next;πend;ππProcedure BufferChain.ChainAtEnd(VAR B : FileBufferPtr);πVARπ BufPtr:FileBufferPtr;πbeginπ If (NumberOfBuffers>1) and (B<>BufferTail) then beginπ BufferTail^.Next:=B;π BufferTail:=B;π If B=BufferHead then beginπ BufferHead:=B^.Next;π B^.Next:=Nil;π end else beginπ Bufptr:=BufferHead;π While BufPtr^.Next<>B do Bufptr:=BufPtr^.Next;π BufPtr^.Next:=B^.Next;π B^.Next:=Nil;π end;π end;πend;πππProcedure BufferFile.Init(BufSize, BufNum:Word; UseEms : Boolean);πVARπ I : Word;πbeginπ If (BufSize=0) or (BufNum=0) then beginπ NoBufferIng:=True;π exit;π end;π UseEms:=UseEms and EmsInstalled andπ (EmsPagesAvail>=BufNum * MemToEms(Bufsize));π Buffers.Init(BufSize, BufNum, USeEms);π FlushAll:=False;π ReadAll:=False;π NoBufferReads:=False;π NoBufferWrites:=False;π NoBuffering:=False;π BlockSize:=BufSize;πend;ππFunction BufferFile.FreeBuffer:FileBufferPtr;πVARπ BufPtr,SavePtr : FileBufferPtr;π LowPos : LongInt;π MyPointer : Pointer;πbeginπ BufPtr:=Buffers.BufferHead;π LowPos:=$7fffffff;π While BufPtr<>Nil do beginπ With BufPtr^ do beginπ If (Not Modified) or (Not initialized) then beginπ FreeBuffer:=BufPtr;π Modified:=False;π FreeBuffer:=BufPtr;π Buffers.ChainAtEnd(BufPtr);π Exit;π end;π If PosBuffer<LowPos then beginπ LowPos:=PosBuffer;π SavePtr:=BufPtr;π end;π BufPtr:=Next;π end;π end;π If FlushAll then beginπ Flush;π FreeBuffer:=Buffers.BufferHead;π end;π With SavePtr^ do beginπ System.Seek(F,PosBuffer);π MyPointer:=Map(0,BytesUsed);π BlockWrite(F,MyPointer^,BytesUsed);π BytesUsed:=0;π Modified:=False;π end;π FreeBuffer:=SavePtr;π Buffers.ChainAtEnd(SavePtr);πend;ππProcedure BufferFile.Flush;πVARπ BufPtr : FileBufferPtr;π MyPointer : Pointer;πbeginπ If NoBuffering then exit;π BufPtr:=Buffers.BufferHead;π While BufPtr<>Nil do beginπ With BufPTr^ do beginπ If Modified then beginπ System.Seek(F,PosBuffer);π MyPointer:=Map(0,BytesUsed);π BlockWrite(F,BufferAddr^,BytesUsed);π Modified:=False;π end;π BufPtr:=Next;π end;π end;πend;ππFunction BufferCHain.BuffersUnUsed:Word;πVARπ BufPtr : FileBufferPtr;π Count : Word;πbeginπ Count:=0;π BufPtr:=BufferHead;π While BufPtr<>Nil do beginπ With BufPtr^ do beginπ If (Not Initialized) or (Not Modified) then Inc(Count);π BufPtr:=Next;π end;π end;π BuffersUnUsed:=Count;πend;ππFunction BufferFile.FileSize:LongInt;πbeginπ If NoBuffering then FileSize:=System.FIleSize(F) elseπ FileSize:=Fsize div RecordSize;πend;ππFunction BufferFile.FilePos:LongInt;πbeginπ If NoBuffering then FilePos:=System.FilePos(F) elseπ FilePos:=CurrentPos div RecordSize;πend;ππProcedure BufferFile.Read(VAR A; NumRecs : Word);πVARπ I,J : Word;π BufPtr : FileBufferPtr;π TargetPtr : BigBlockPtr;π More : Boolean;π BaseBufferToGet : LongInt;π MyPointer : Pointer;πbeginπ If NoBuffering then BlockRead(F,A,NuMRecs) else beginπ NumRecs:=NumRecs*RecordSize;π TargetPtr:=@A;π Repeatπ BaseBufferToGet:=CurrentPos-(CurrentPos Mod BlockSize);π BufPtr:=Buffers.BufferHead;π More:=True;π While (BufPtr<>Nil) and More Do beginπ With BufPtr^ do beginπ If (PosBuffer=BaseBufferToGet) and Initialized then more:=False elseπ BufPtr:=Next;π end;π end;π If BufPtr=Nil then beginπ If NoBufferReads then beginπ System.Seek(F,CurrentPos);π BlockRead(F,TargetPtr^,NumRecs);π Inc(CurrentPos,NumRecs);π exit;π end;π BufPtr:=FreeBuffer;π With BufPtr^ do beginπ System.Seek(F,BaseBufferToGet);π PosBuffer:=BaseBufferToGet;π MyPointer:=Map(0,BlockSize);π BlockRead(F,MyPointer^,BlockSize,BytesUsed);π Initialized:=True;π end;π If ReadAll then beginπ J:=Buffers.BuffersUnUsed;π If J>0 then Dec(j);π I:=1;π While (I<= J) and (BufPtr^.BytesUsed=BlockSize) do beginπ Inc(BaseBufferToGet,BlockSize);π BufPtr:=FreeBuffer;π With BufPtr^ do beginπ PosBuffer:=BaseBufferToGet;π MyPointer:=Map(0,BlockSize);π BlockRead(F,MyPointer^,BlockSize,BytesUsed);π Initialized:=True;π end;π Inc(I);π end;π end;π end else beginπ With BufPtr^ do beginπ J:=CurrentPos-PosBuffer;π I:=BytesUsed-j;π If I>NumRecs then I:=NumRecs;π MyPointer:=Map(J,I);π Move(MyPointer^,TargetPtr^,I);π Inc(CurrentPos,I);π Dec(NumRecs,I);π Inc(PtrRec(TargetPtr).Ofs,I);π end;π end;π until NumRecs=0;π end;πend;ππProcedure BufferFile.Write(VAR A; NumRecs : Word);πVARπ I,J : WOrd;π BufPtr : FileBufferPtr;π TargetPTr,MyPointer : Pointer;π BaseBufferToGet : LongInt;π BytesNeeded : LongInt;π OK,More : Boolean;πbeginπ If NoBuffering then BlockWrite(F,A,NumRecs) else beginπ TargetPtr:=@A;π NumRecs:=NumRecs*RecordSize;π Repeatπ BaseBufferToGet:=CUrrentPos-(CurrentPos Mod BlockSize);π BufPtr:=Buffers.BufferHead;π More:=True;π While (BufPtr<>Nil) and More Do beginπ With BufPtr^ do beginπ If (Initialized) and (BaseBufferToGet=PosBuffer) then beginπ BytesNeeded:=CurrentPos-PosBuffer+NumRecs;π If BytesNeeded>BytesUsed then beginπ If BytesNeeded>BlockSize then BytesUsed:=BlockSize elseπ BytesUsed:=BytesNeeded;π Fsize:=BaseBufferToGet+BytesUsed;π end;π More:=False;π end else BufPtr:=Next;π end;π end;π If BufPtr=Nil then beginπ If NoBufferWrites then beginπ If BaseBufferToGet<>CurrentPos then beginπ System.Seek(F,CurrentPos);π BlockWrite(F,A,NumRecs);π Inc(CurrentPos,NumRecs);π exit;π end;π end;π BufPtr:=FreeBuffer;π With BufPtr^ do beginπ System.Seek(F,BaseBufferToGet);π PosBuffer:=BaseBufferToGet;π If PosBuffer<SyStem.FileSize(F) then beginπ MyPointer:=Map(0,BlockSize);π BlockRead(F,MyPointer^,BlockSize,BytesUsed);π end else BytesUsed:=0;π Initialized:=True;π end;π end else beginπ With BufPtr^ do beginπ J:=CurrentPos-PosBuffer;π I:=BytesUsed-j;π If I>NumRecs then I:=NumRecs;π MyPointer:=Map(J,I);π Move(TargetPtr^,MyPointer^,I);π Modified:=True;π Inc(CurrentPos,I);π Dec(NumRecs,I);π Inc(PtrRec(TargetPtr).Ofs,I);π end;π end;π until NumRecs=0;π end;πend;ππFunction BufferFile.Eof:Boolean;πbeginπ If NoBuffering then Eof:=System.Eof(F) elseπ Eof:=CurrentPos=Fsize;πend;ππProcedure BufferFile.Seek(NewPos : LongInt);πbeginπ If NoBuffering then System.Seek(F,Newpos) elseπ CurrentPos:=NewPos*RecordSize;πend;ππProcedure BufferFile.Assign(Name : PathStr);πbeginπ System.Assign(F,Name);πend;ππProcedure BufferFile.Rewrite(RecSize:Word);πbeginπ RecordSize:=RecSize;π If Not NoBuffering then Recsize:=1;π System.Rewrite(F,RecSize);π Fsize:=0;π CurrentPos:=0;πend;ππProcedure BufferFile.Reset(RecSize : Word);πbeginπ RecordSize:=RecSize;π If Not NoBuffering then RecSize:=1;π System.Reset(F,RecSize);π Fsize:=System.FileSize(F);π CurrentPos:=0;πend;ππProcedure BufferChain.Done;πbeginπ repeatπ with BufferHead^ do beginπ BufferTail:=BufferHead^.Next;π Dispose(BufferHead,Done);π BufferHead:=BufferTail;π end;π until Bufferhead=Nil;πend;ππProcedure BufferFile.Done;πVARπ BufferTail : BufferPtr;π Ok : Boolean;πbeginπ Flush;π Close(F);π If Not NoBuffering then Buffers.Done;πend;πend.ππ 2 08-24-9413:29ALL WIM VAN DER VEGT Call Stack Reporter SWAG9408 ∞ó╩? 128 ä▒ {---------------------------------------------------------}π{ Project : Call Stack Reporter }π{ Auteur : Ir. G.W. van der Vegt }π{ Hondsbroek 57 }π{ 6121 XB Born }π{---------------------------------------------------------}π{ Datum .tijd Revisie }π{ 920713.2100 Creatie. }π{ 920715.2330 Trace at normal exit (exitcode=0) removed.}π{ 920805.2230 Path removed from filename in trace }π{ 920806.2200 Blanks filled in, RunTime Library routines}π{ now traced to. }π{ 921026.2000 Textmode(lastmode) added to default }π{ Csr_report. Objects & overlay tracing }π{ tested. }π{ 921118.1400 Exitcode doesn't trigger trace anymore }π{ 931114.1430 Keyboard flush in exitprocedure }π{ 940201.2200 Made independed of Routines. }π{---------------------------------------------------------}π{ To do Trace Virtual Methode Table (VMT) }π{---------------------------------------------------------}ππ{$D+}π{$L+}ππ{---------------------------------------------------------}π{----This unit gives the line numbers & filenames at error}π{ The result is a list of the call stack as produced by}π{ the Turbo Pascal IDE. }π{ }π{ The internal text mode report function can be }π{ replaced by another one located in your program. }π{ This could be a graphics mode or printer version. It }π{ must be compiled far (so use $F+ & $F- around it. }π{ It's called once for each call level. }π{ }π{ This program parses the MAP file to obtain the }π{ line numbers. It searches for the MAP file in the }π{ programs startup directory as obtained by }π{ PARAMSTR(0). }π{---------------------------------------------------------}π{ To obtain all possible info compile with the }π{ following setting : }π{ }π{ OPTIONS/LINKER/MAP FILE = DETAILED }π{ OPTION/COMPILE/DEBUG INFO = ON }π{ }π{ The last can also be forced by the $D+ compiler }π{ directive . }π{ }π{ This version traces procedures, functions through }π{ the main program and it's (overlayed) units. It also }π{ traces static methodes but not virtual methodes. }π{ When tracing static methodes a phantom entry with }π{ an call address located oon the heap is generated. }π{ The trace is stopped at the first call to a virtual }π{ methode. In a future version VMT tracing will be }π{ added as soon as I start using virtual methodes. }π{---------------------------------------------------------}ππUNIT CSR_01;ππINTERFACEππ{---------------------------------------------------------}π{----TYPES }π{---------------------------------------------------------}ππTYPEπ Csr_repfunc = PROCEDURE(level : Word;csr : STRING);ππ{---------------------------------------------------------}π{----VARIABLES }π{---------------------------------------------------------}ππVARπ Csr_reporter : Csr_repfunc;ππ{---------------------------------------------------------}π{----PROCEDURES/FUNCTIONS }π{---------------------------------------------------------}ππPROCEDURE Csr_report(level : Word;csr : STRING);ππ{---------------------------------------------------------}ππIMPLEMENTATIONππUsesπ CRT,π DOS;ππVARπ ext : extstr;π dir : dirstr;π nam : namestr;π mapfile : BOOLEAN;π map : Text;π ft : BOOLEAN;ππCONSTπ space = #32;ππ{---------------------------------------------------------}π{----SUPPORT PROCEDURES & FUNCTIONS }π{---------------------------------------------------------}ππFUNCTION Istr(i,n : INTEGER;pad : CHAR) : STRING;ππVARπ s : STRING;ππBEGINπ Str(i:n,s);π IF (pad<>space)π THENπ WHILE (Pos(space,s)>0) DOπ s[Pos(space,s)]:=pad;π Istr:=s;πEND; {of Istr}ππ{---------------------------------------------------------}ππFUNCTION Wstr(w : WORD;n : INTEGER) : STRING;ππVARπ s : STRING;ππBEGINπ Str(w:n,s);π Wstr:=s;πEND; {of Wstr}ππ{---------------------------------------------------------}ππFUNCTION Sstr(s : STRING;n : INTEGER) : STRING;ππVARπ tmp : STRING;ππBEGINπ tmp:=s;π IF n>=0π THEN WHILE (Length(tmp)<+n) DO Insert(space,tmp,1)π ELSE WHILE (Length(tmp)<-n) DO tmp:=tmp+space;π Sstr:=tmp;πEND; {of Sstr}ππ{---------------------------------------------------------}ππPROCEDURE Beep;ππBEGINπ Sound(500);π Delay(20);π Nosound;πEND; {of Beep}ππ{---------------------------------------------------------}ππFUNCTION Word2Hex(w : Word) : STRING;ππconstπ hexChars : array [0..$F] of Char = '0123456789ABCDEF';ππbeginπ Word2Hex :=hexChars[Hi(w) shr 4]+hexChars[Hi(w) and $F]+π hexChars[Lo(w) shr 4]+hexChars[Lo(w) and $F];πend; {of Word2Hex}ππ{---------------------------------------------------------}ππFunction Hex2Word(h : String) : word;ππconstπ hexChars : String[16] = '0123456789ABCDEF';ππvarπ f : word;ππbeginπ f := 0;π while length(h) > 0 doπ beginπ if pos(Copy(h,1,1),HexChars) = 0π then f := 0π Else f := (f*16)+pos(H[1],Hexchars)-1;π delete(h,1,1);π end;π Hex2Word:= f;πend; {of Hex2Word}ππ{---------------------------------------------------------}ππFUNCTION Ptr2Hex(p : POINTER) : STRING;ππBEGINπ IF (p=nil)π THEN Ptr2Hex := ' NIL 'π else Ptr2Hex := Word2hex(Seg(P^))+':'+Word2hex(Ofs(P^));πEND; {of Ptr2Hex}ππ{---------------------------------------------------------}ππProcedure FlushKbd;ππBeginπ MemW[$40:$1C]:=MemW[$40:$1A];πEnd; {of Fluskkbd}ππ{---------------------------------------------------------}π{----STACK TRACE ROUTINES START HERE }π{---------------------------------------------------------}ππFUNCTION BPreg : WORD;ππINLINE($55/$58); {Push BP, Pop AX}ππ{---------------------------------------------------------}ππProcedure Findlineno(first,near : BOOLEAN;dep : Word;p : Pointer);ππVARπ tmp : String[80];ππ line : Integer;π adr : String[9];π ch : Char;ππ fn : STRING[80];π un : STRING[80];ππ errseg,π errofs : Word;ππ s,π lastun,π lastpr,π lastfn : STRING[80];π lastnr : Word;π call : STRING[4];ππBEGINπ IF nearπ THEN call:='near'π ELSE call:='far ';ππ errseg:=Hex2word(Copy(Ptr2hex(p),1,4));π errofs:=Hex2word(Copy(Ptr2hex(p),6,4));ππ lastnr:=0;π lastfn:='';π lastpr:='';π lastun:='';ππ Assign(map,dir+nam+'.MAP');π {$I-} Reset(map); {$I+}π IF (IOResult=0)π THENπ BEGINπ {----Fist try on unit/program name}π s:='';π{π 00000H 00096H 00097H VALTOREN CODEππ Address Publics by Valueπ}π WHILE NOT(Eof(map) ORπ (Pos('Publics by Value',s)>0) ORπ (Pos('Line numbers' ,s)>0)) DOπ BEGINπ Readln(map,s);π IF (Length(s)>=45) AND (s[7]='H')π THENπ BEGINπ IF (Errseg=Hex2Word(Copy(s,2,4))) {ANDπ (Copy(s,42,4)='CODE')}π THEN lastun:=Copy(s,23,18);π END;π END;ππ {----Strip Trailing Blanks}π WHILE (Length(lastun)>0) ANDπ (lastun[Length(lastun)]=#32) DOπ Delete(lastun,Length(lastun),1);ππ {----Second Try to find procedure name}π s:='';π{π Address Publics by Valueππ 0000:0000 @π 000A:00CB MENU_INITπ}π WHILE NOT(Eof(map) ORπ (Pos('Line numbers',s)>0)) DOπ BEGINπ Readln(map,s);π IF (Length(s)>=18) AND (s[6]=':')π THENπ BEGINπ IF (Errseg=Hex2Word(Copy(s,2,4)))π THENπ BEGINπ IF (lastpr='')π THEN lastpr:=Copy(s,18,Length(s)-17)π ELSEπ IF (Errofs>=Hex2Word(Copy(s,7,4)))π THEN lastpr:=Copy(s,18,Length(s)-17);π END;π END;π END;ππ {----Strip Trailing Blanks}π WHILE (Length(lastpr)>0) ANDπ (lastpr[Length(lastpr)]=#32) DOπ Delete(lastpr,Length(lastpr),1);ππ {----Third try on line numbers & sourcefile names}π REPEATπ{π Line numbers for TEST_ERROR(TEST_ERR.PAS) segment TEST_ERRORπ}π IF (Pos('Line numbers',s)>0)π THENπ BEGINπ Delete(s,1,17);π un:=Copy(s,1,Pos('(',s)-1);π Delete(s,1,Pos('(',s));π fn:=Copy(s,1,Pos(')',s)-1);ππ While Pos('\',fn)>0 DO Delete (fn,1,Pos('\',fn));ππ Readln(map);π REPEATπ{π 15 0000:0008 16 0000:0017 18 0000:00C4 28 0000:00D2π}π Read(map,line);π Read(map,ch);π Read(map,adr);π IF (Errseg=Hex2Word(Copy(adr,1,4)))π THENπ BEGINπ lastfn:=fn;π IF (Errofs>=Hex2Word(Copy(adr,6,4)))π THEN lastnr:=line;π END;ππ If Eoln(map)π Then Readln(map);ππ UNTIL Eoln(map);π END;ππ IF NOT(eof(map))π THEN Readln(map,s);ππ UNTIL Eof(map) OR ((lastnr<>0) OR (lastfn<>''));ππ Close(map);ππ Beep;ππ IF (lastfn<>'') AND ((errseg<>0) OR (errofs<>0))π THENπ {----Report Line Number & Source File}π BEGINπ WHILE (length(lastfn)<12) DO Insert(#32,lastfn,1);π If firstπ THENπ Csr_reporter(dep,'Runtime error '+Istr(exitcode,3,'0')+π ' in line '+Wstr(lastnr,4)+π ' of '+lastfn+π ' at '+Word2hex(errseg)+':'+Word2Hex(errofs)+'.')π ELSEπ Csr_reporter(dep,' Called '+call+' from line '+Wstr(lastnr,4)+π ' of '+lastfn+π ' at '+Word2hex(errseg)+':'+Word2Hex(errofs)+'.');π ENDπ ELSEπ BEGINπ IF (lastun<>'') OR (lastpr<>'')π THENπ {----Report Unit/Program Name & Procedure name}π BEGINπ IF (Pos('@',lastpr)>0)π THEN s:=lastun+'.MAIN'π ELSE s:=lastun+'.'+lastpr;ππ WHILE (Length(s)>25) DOπ Delete(s,Length(s),1);ππ If firstπ THENπ Csr_reporter(dep,'Runtime error '+Istr(exitcode,3,'0')+π ' in '+Sstr(s,25)+π ' at '+Word2hex(errseg)+':'+Word2Hex(errofs)+'.')π ELSEπ Csr_reporter(dep,' Called '+call+' from '+Sstr(s,25)+π ' at '+Word2hex(errseg)+':'+Word2Hex(errofs)+'.');π ENDπ ELSEπ {----Report Error Address Only}π BEGINπ If firstπ THENπ Csr_reporter(dep,'Runtime error '+Istr(exitcode,3,'0')+π ' '+π ' '+π ' at '+Word2hex(errseg)+':'+Word2Hex(errofs)+'.')π ELSEπ Csr_reporter(dep,' Called '+call+' from line '+π ' '+π ' at '+Word2hex(errseg)+':'+Word2Hex(errofs)+'.');π END;π END;π ENDπ ELSEπ {----Report Error Addres Only}π Csr_reporter(dep,'Runtime error '+Istr(exitcode,0,'0')+π ' at '+Word2hex(errseg)+':'+Word2Hex(errofs)+'.')πEND; {of Findlineno}ππ{---------------------------------------------------------}π{$F+}ππVARπ exitsave : POINTER;ππPROCEDURE Myexit;ππVARπ ch : Char;π cdiv,π csmin,π cs,π sp,π ss : WORD;π p : Pointer;π dep : WORD;π j : INTEGER;ππBEGINπ Flushkbd;ππ Exitproc:=exitsave;ππ IF (exitcode=0) OR (erroraddr=NIL) THEN Exit;ππ sp:=BPreg;π ss:=SSeg;ππ{----Calculate calling depth}π dep:=0;π p:=Ptr(ss,sp);π WHILE MemW[ss:Ofs(p^)]<>0 DOπ BEGINπ IF (Mem[cs:MemW[ss:Ofs(p^)+2]-3]<>$E8)π THEN cs:=MemW[ss:Ofs(p^)+4];ππ p:=Ptr(ss,MemW[ss:Ofs(p^)]);π Inc(dep);π END;ππ p:=Ptr(ss,sp);π cdiv :=Cseg-cs;π csmin:=cs;π cs :=Cseg;ππ{----Report Runtime address}π Findlineno(true,true,dep,erroraddr);π Dec(dep);ππ{----Calculate cseg at runtime error}π cs:=csmin+Seg(erroraddr^);ππ{----Prevent Turbo Pascal from reporting}π Erroraddr:=NIL;ππ If NOT(mapfile) THEN Exit;ππ{----Skip Runtime error handler entry}π IF (MemW[ss:Ofs(p^)]<>0)π THEN p:=Ptr(ss,MemW[ss:Ofs(p^)]);ππ{----Report Call Stack}π WHILE MemW[ss:Ofs(p^)]<>0 DOπ BEGINπ {----Test for near call instruction 3 bytes before return address}π IF (Mem[cs:MemW[ss:Ofs(p^)+2]-3]=$E8)π {----Trace a near call}π THEN Findlineno(false,true,dep,Ptr(WORD(Cs+Cdiv-Cseg),MemW[ss:Ofs(p^)+2]-3))π ELSEπ {----Trace a far call}π BEGINπ Cs:=MemW[ss:Ofs(p^)+4];π Findlineno(false,false,dep,Ptr(WORD(Cs+Cdiv-Cseg),MemW[ss:Ofs(p^)+2]-3));π END;ππ {----Increment stackpointer}π p:=Ptr(ss,MemW[ss:Ofs(p^)]);π Dec(dep);π END;ππEND; {of Myexit}ππ{---------------------------------------------------------}ππPROCEDURE Csr_report(level : Word;csr : STRING);ππBEGINπ IF ftπ THENπ BEGINπ Textmode(lastmode);π ft:=false;π END;π Writeln(csr+' (',level,')');πEND; {of Csr_report}π{$F-}π{---------------------------------------------------------}ππBEGINπ exitsave:=Exitproc;π exitproc:=@Myexit;π csr_reporter:=Csr_report;ππ Fsplit(Paramstr(0),dir,nam,ext);π Assign(map,dir+nam+'.MAP');π {$I-} Reset(map); {$I+}π IF (IOResult=0)π THENπ BEGINπ mapfile:=true;π Close(map);π ENDπ ELSE mapfile:=false;ππ ft:=true;πEND.ππ{ STACK UNIT NEEDED FOR CRS_01}ππUNIT Stack1;ππINTERFACEππPROCEDURE test2(VAR i : Integer);ππIMPLEMENTATIONππVARπ i : INTEGER;ππ{---------------------------------------------------------}ππPROCEDURE test2(VAR i : Integer);ππPROCEDURE test4(i : INTEGER);ππVARπ tmp : Integer;ππBEGINπ tmp:=0;π i:=1 div tmp;πEND;ππBEGINπ test4(i);πEND;ππ{---------------------------------------------------------}ππBEGINπ i:=1;πEND.πππ{ ------------------------------- DEMO ------------------------}π{---------------------------------------------------------}πPROGRAM Csrtst;ππUSESπ CRT,π Csr_01,π Stack1;ππ{---------------------------------------------------------}ππPROCEDURE test3;ππVARπ i : INTEGER;ππBEGINπ test2(i);πEND;ππ{---------------------------------------------------------}ππPROCEDURE test4;ππBEGINπ test3πEND;ππ{---------------------------------------------------------}ππBEGINπ clrscr;π test4;πEND.π 3 08-24-9413:32ALL ROB SPOREN PROTECTED MODE SWAG9408 σ∞┤ε 23 ä▒ π{π SM> I have a bit of a problem with pascal 7 protected mode,π SM> I have a TSR (assembly) that does my comms work for me.π SM> I use intr(regs) with various settings to the registers to collectπ SM> data from the TSR. However when in protected mode my TSR seemsπ SM> to be unavailable.ππI had the same problem, it seems that the DOS unit does not support protectedπmode interrupt handling. I solved it by looking though some documentation Iπfound on protected mode, below is a simple unit to set and get protectedπmode interrupts.ππIn my case the interrupt goes about 22Khz so it kept switching into real modeπand back just to handle the interrupt, the result it crashed.ππ SM> Do I need to switch to real mode from the app.π SM> (if so how, I can't find it in the manual).ππNo, see above.ππ SM> Do I need to modify my TSR.π SM> I presume not because I'm sure that the mouse drivers can be gotπ SM> to work.ππThe MOUSE is handled by the DOS extender.ππCheersπ RobππP.S. I noticed that you use the same BBS, if you have any problems dropπme a note.π}ππUnit DPMIDos; { This code was a quick hack job to solve my problem }π { don't expect it to be neat! }ππINTERFACEππFunction RealMode : Boolean;πFunction AllocateLDT(NumberDescriptors : Word) : Word;πFunction FreeLDT(Selector : Word) : Boolean;πFunction SegmentToDescriptor(Segment : Word) : Word;πFunction GetNextSelectorInc : Word;πFunction GetDPMIntVec(IntNumber : Byte) : Pointer;πProcedure SetDPMIntVec(IntNumber : Byte; IntVec : Pointer);ππIMPLEMENTATIONππFunction RealMode : Boolean; assembler;πasmπ mov ax, 01686hπ int 02Fhπend;ππFunction AllocateLDT(NumberDescriptors : Word) : Word; assembler;πasmπ mov ax, 0000hπ mov ax, NumberDescriptorsπ int 031hπ jnc @Okπ mov ax, 0π @Ok:πend;ππFunction FreeLDT(Selector : Word) : Boolean; assembler;πasmπ mov ax, 0001hπ mov bx, Selectorπ int 031hπ mov ax, 1π jnc @Okπ mov ax, 0π @Ok:πend;ππFunction SegmentToDescriptor(Segment : Word) : Word; assembler;πasmπ mov ax, 0002hπ mov bx, Segmentπ int 31hπ jnc @Okπ mov ax, 0π @Ok:πend;ππFunction GetNextSelectorInc : Word; assembler;πasmπ mov ax, 0003hπ int 031hπend;πππFunction GetDPMIntVec(IntNumber : Byte) : Pointer; {assembler;}πVar S, O : Word; { Too lazy to look in the manual! }πBeginπ asmπ mov ax, 0204hπ mov bl, IntNumberπ int 031hπ mov S, cxπ mov O, dxπ end;π GetDPMIntVec := Ptr(S, O);πEnd;πππProcedure SetDPMIntVec(IntNumber : Byte; IntVec : Pointer); assembler;πasmπ mov ax, 0205hπ mov bl, IntNumberππ les dx, IntVecπ mov cx, esππ int 031hπend;ππbeginπend.π 4 08-24-9413:34ALL ANDREW EIGUS Lim EMS Library SWAG9408 ⌐≈¿ 68 ä▒ {This unit is a kit to EMS functions.}ππUnit EMSLib;π{ Copyright (c) 1994 by Andrew Eigus FidoNet: 2:5100/33 }π{ LIM EMS Interface V1.01 for Turbo Pascal version 7.0 }ππ(*π Material used:π Interrupt List V1.02 (WindowBook) (c) 1984-90 Box Company, Inc.π Tech Help V4.50π*)ππ{$X+} { Enable extended syntax }π{$G+} { Enable 286 instructions }ππinterfaceππconstππ PageSize = 16384; { EMS Page size: 16384 bytes }ππ { LIM EMS 3+ function numbers }ππ EGetPageFrame = $41;π EGetPageCount = $42;π EAllocPages = $43;π EMapPages = $44;π EReleasePages = $45;π EGetVersion = $46;ππ { LIM EMS functions result codes }ππ emsrOk = $00; { Function successful }π emsrNotInitd = $01; { EMS not installed }π emsrIntrnlError = $80; { Internal error }π emsrHardwareMalf = $81; { Hardware malfunction }π emsrBadHandle = $83; { Invalid handle }π emsrBadFunction = $84; { Undefined function requested }π emsrNoMoreHandles = $85; { No more handles available }π emsrMapContError = $86; { Error in save or restore of mapping context }π emsrMorePagesPhys = $87; { More pages requested than physically exist }π emsrMorePagesCurr = $88; { More pages requested than currently available }π emsrZeroPages = $89; { Zero pages requested }π emsrBadPageLogNum = $8A; { Invalid page logical number }π emsrBadPagePhyNum = $8B; { Invalid page physical number }ππfunction EMS_Setup : boolean;πfunction EMS_GetVersion(var Version : byte) : byte;πfunction EMS_GetMemAvail(var FreeMem : word) : byte;πfunction EMS_AllocEMB(var Handle, PageSeg : word; Pages : word) : byte;πfunction EMS_FreeEMB(Handle : word) : byte;πfunction EMS_MapPages(Handle, LogicalPage : word; PhysicalPage : byte) : byte;ππfunction EMS_GetErrorMsg(ErrorCode : byte) : string;ππimplementationππconstπ DOS = $21; { DOS interrupt number }π EMS = $67; { EMS interrupt number }ππvarπ EMSInitd : boolean;ππFunction EMS_Setup; assembler;π{ EMM Installation check }πconst DeviceDriver : PChar = 'EMMXXXX0';πAsmπ MOV EMSInitd,Falseπ PUSH DSπ MOV AX,3D02h { DOS function to open the device as file }π LDS DX,DeviceDriverπ INT DOSπ POP DSπ JC @@1π PUSH AX { store device handle to close the file afterwards }π MOV AX,4407h { DOS function to test device status }π INT DOSπ MOV EMSInitd,ALπ POP BXπ MOV AH,3Eh { close the file using it's handle in BX }π INT DOSπ@@1:π MOV AL,EMSInitdπEnd; { EMS_Setup }ππFunction EMS_GetVersion; assembler;π{ Get Expanded Memory Manager version number }πAsmπ MOV AL,emsrNotInitdπ CMP EMSInitd,False { If library not initialized by EMS_Setup }π JE @@1 { then exit }π MOV AH,EGetVersion { Get EMS version }π INT EMSπ LES DI,Versionπ MOV [ES:DI],AL { Store version number }π MOV AL,AH { Store result byte }π@@1:πEnd; { EMS_GetVersion }ππFunction EMS_GetMemAvail; assembler;π{ Returns free memory in FreeMem parameter }πAsmπ MOV AL,emsrNotInitdπ CMP EMSInitd,Falseπ JE @@1π MOV AH,EGetPageCountπ INT EMSπ SHL BX,4 { Got in pages, convert to K-bytes }π LES DI,FreeMemπ MOV [ES:DI],BX { Store memory available in K-Bytes }π MOV AL,AH { Store result byte }π@@1:πEnd; { EMS_GetMemAvail }ππFunction EMS_AllocEMB; assembler;π{ Allocates specified number of 16 K-byte pages and returns handle number inπ Handle parameter. Page frame segment address stored in PageSeg. To accessπ data, use the following function:π DataPtr := Ptr(PageSeg, PhysicalPageNumber * PageSize) }πAsmπ MOV AL,emsrNotInitdπ CMP EMSInitd,Falseπ JE @@2π MOV AH,EGetPageFrameπ INT EMSπ CMP AH,0π JNE @@1π LES DI,PageSeg { Store page frame segment }π MOV [ES:DI],BXπ MOV BX,Pagesπ MOV AH,EAllocPagesπ INT EMSπ LES DI,Handleπ MOV [ES:DI],DX { Store handle number }π@@1:π MOV AL,AH { Return result code }π@@2:πEnd; { EMS_AllocEMB }ππFunction EMS_FreeEMB; assembler;π{ Deallocates (releases) allocated expanded memory }πAsmπ MOV AL,emsrNotInitdπ CMP EMSInitd,Falseπ JE @@1π MOV AH,EReleasePagesπ MOV DX,Handleπ INT EMSπ MOV AL,AH { Return result code }π@@1:πEnd; { EMS_FreeEMB }ππFunction EMS_MapPages; assembler;π{ Maps a logical page number at physical page number }πAsmπ MOV AL,emsrNotInitdπ CMP EMSInitd,Falseπ JE @@1π MOV AH,EMapPagesπ MOV DX,Handleπ MOV BX,LogicalPageπ MOV AL,PhysicalPageπ INT EMSπ MOV AL,AHπ@@1:πEnd; { EMS_MapPages }ππFunction EMS_GetErrorMsg;π{ Get an error message according to ErrorCode }πBeginπ case ErrorCode ofπ emsrNotInitd: EMS_GetErrorMsg := 'EMM not initialized';π emsrIntrnlError: EMS_GetErrorMsg := 'Internal error';π emsrHardwareMalf: EMS_GetErrorMsg := 'Hardware malfunction';π emsrBadHandle: EMS_GetErrorMsg := 'Invalid block handle';π emsrBadFunction: EMS_GetErrorMsg := 'Function not implemented';π emsrNoMoreHandles: EMS_GetErrorMsg := 'No more handles available';π emsrMapContError: EMS_GetErrorMsg := 'Error in save or restore of ' +π'mapping context';π emsrMorePagesPhys: EMS_GetErrorMsg := 'More pages requested than ' +π'physically exist';π emsrMorePagesCurr: EMS_GetErrorMsg := 'More pages requested than ' +π'currently available';π emsrZeroPages: EMS_GetErrorMsg := 'Zero pages requested';π emsrBadPageLogNum: EMS_GetErrorMsg := 'Invalid page logical number';π emsrBadPagePhyNum: EMS_GetErrorMsg := 'Invalid page physical number';π else EMS_GetErrorMsg := 'Unknown error'π endπEnd; { EMS_GetErrorMsg }ππBeginπ EMSInitd := FalseπEnd. { EMSLib }ππ{ -------------------------- DEMO --------------------------------- }ππProgram EMSLibDemo;π{ Copyright (c) 1994 by Andrew Eigus FidoNet: 2:5100/33 }π{ LIM EMS Interface V1.01 for Turbo Pascal version 7.0 demonstration program }ππ(*π Tested on IBM 486 SX 33Mhz with 4MB RAM with the following configuration:π HIMEM.SYS (MS-DOS 6.2 XMS memory manager)π EMM386.EXE (MS-DOS 6.2 EMS memory manager)ππ If any bugs occur in your system while running this demo,π please inform me:ππ AndRew's BBS Phone: 003-712-559777 (Riga, Latvia) 24h 2400bpsπ Voice Phone: 003-712-553218π FidoNet: 2:5100/33π E-Mail: aeigus@fgate.castle.riga.lvπ*)ππ{$X+}{$R-} { Enable extended syntax }ππuses EMSLib;ππtype TMsg = array[1..13] of Char;ππconstπ Message1 : TMsg = 'First string ';π Message2 : TMsg = 'Second string';ππvarπ Version : byte;π FreeMemory, Handle, SegAddr, I : word;π P : pointer;ππFunction Hex(Num : longint; Places : byte) : string;πconst HexTab : array[0..15] of Char = '0123456789ABCDEF';πvarπ HS : string[8];π Digit : byte;πBeginπ HS[0] := Chr(Places);π for Digit := Places downto 1 doπ beginπ HS[Digit] := HexTab[Num and $0000000F];π Num := Num shr 4π end;π Hex := HSπEnd; { Hex }ππFunction Check(Result : byte; Func : string) : byte;πBeginπ if Result <> emsrOk thenπ WriteLn(Func, ' returned ',π Hex(Result, 2), 'h (', Result, '): ', EMS_GetErrorMsg(Result));π Check := ResultπEnd; { Check }ππProcedure PrintFreeMemory;πBeginπ WriteLn;π if Check(EMS_GetMemAvail(FreeMemory), 'EMS_GetMemAvail') = emsrOk thenπ WriteLn('EMS memory available: ', FreeMemory, ' KB');π WriteLnπEnd; { PrintFreeMemory }ππBeginπ WriteLn('LIM EMS Library V1.01 Demonstration program by Andrew Eigus'#10);π if EMS_Setup thenπ beginπ if Check(EMS_GetVersion(Version), 'EMS_GetVersion') = emsrOk thenπ WriteLn('EMS driver version ',π Version shr 4, '.', Version shr 8, ' detected');π PrintFreeMemory;π if FreeMemory = 0 then Halt(8);π if Check(EMS_AllocEMB(Handle, SegAddr, 1), 'EMS_AllocEMB') = emsrOk thenπ beginπ WriteLn('Message1: ', Message1);π WriteLn('Message2: ', Message2);π WriteLn('16 KB (one page) of EMS allocated. Linear address: ',π Hex(SegAddr, 8), 'h');π PrintFreeMemory;π WriteLn('Transferring Message1 to EMS...');π for I := 0 to SizeOf(TMsg) - 1 doπ EMS_MapPages(Handle, I, 0);π P := Ptr(SegAddr, 0);π Move(Message1, P^, SizeOf(TMsg));π WriteLn('Transferring Message1 from EMS to Message2...');π Move(P^, Message2, SizeOf(TMsg));π WriteLn('Message1: ', Message1);π WriteLn('Message2: ', Message2);π if Check(EMS_FreeEMB(Handle), 'EMS_FreeEMB') = emsrOk thenπ beginπ WriteLn('Memory deallocated (released). ');π PrintFreeMemoryπ endπ endπ end elseπ WriteLn('EMM386 manager not installed.');πEnd.π 5 08-24-9413:39ALL ERIC LOWE Flush Smartdrv SWAG9408 .╔J# 3 ä▒ ππUses Dos;ππProcedure Flush_Cache;π{ This will work with SmartDrive 4.00+ and PC-Cache 8.0+. }ππVar Reg: Registers;ππBeginπ Reg.AX:=$4A10;π Reg.BX:=$0001;π Intr($2F,Reg);πEnd;ππBEGINπFlush_Cache;πEND.ππ 6 08-24-9413:46ALL ANDREW EIGUS 256k Memory in BASM SWAG9408 ╤#'⌐ 22 ä▒ {π CF> Ok I know in pascal you can basiclly us up t0 64k for varibles.... But howπ CF> can I set it up to use... lets say 256k for varibles. I mean, -XMS-π CF> memeory? =- Chris ForbisππFirst, you may allocate 256k without XMS. Just using the following routines:πππfunction DosMaxAvail : longint;πfunction MemAlloc(Size : longint) : pointer;πfunction MemFree(P : pointer) : integer;πfunction MemRealloc(P : pointer; NewSize : longint) : integer;π}ππFunction DosMaxAvail : longint; assembler;π{ Returns the size of the largest contiguous free memory blockπ This function should be called ONLY when both HeapMin/HeapMaxπ memory allocation parameters set to zero }πAsmπ MOV BX,0FFFFhπ MOV AH,48hπ INT 21hπ MOV AX,BXπ MOV BX,16π MUL BXπEnd; { DosMaxAvail }ππFunction MemAlloc(Size : longint) : pointer; assembler;π{ Creates a dynamic variable of the specified size and returns the pointerπ to it. This function should be called ONLY when both HeapMin/HeapMaxπ memory allocation parameters set to zero }πAsmπ@@1:π MOV AX,WORD PTR [Size]π MOV DX,WORD PTR [Size+2]π MOV CX,16π DIV CXπ INC AXπ MOV BX,AXπ MOV AH,48hπ INT 21hπ JNC @@2π XOR AX,AXπ@@2:π MOV DX,AXπ XOR AX,AXπEnd; { MemAlloc }ππProcedure MemFree(P : pointer); assembler;π{ Disposes of a given dynamic variable. This function should be called ONLYπ when both HeapMin/HeapMax memory allocation parameters set to zero }πAsmπ MOV ES,WORD PTR [P+2]π MOV AH,49hπ INT 21hπEnd; { MemFree }ππFunction MemRealloc(P : pointer; NewSize : longint) : pointer; assembler;π{ Changes the size of en existed memory block. This function should be calledπ ONLY when both HeapMin/HeapMax memory allocation parameters set to zero }πAsmπ@@1:π MOV AX,WORD PTR [NewSize]π PUSH AXπ MOV DX,WORD PTR [NewSize+2]π PUSH DXπ MOV CX,16π DIV CXπ INC AXπ MOV BX,AXπ MOV AH,4Ahπ INT 21hπ POP DXπ POP AXπ JNC @@2π XOR DX,DXπ XOR AX,AXπ@@2:πEnd; { MemRealloc }ππ{ Okey, the main program: }ππ{$M 4096,0,0}ππconst MemToAlloc = 256 * 1024; { 256k }πvar MemoryBlock : pointer;πBeginπ if DosMaxAvail >= MemToAlloc thenπ beginπ WriteLn('Dos free memory before allocating ',π MemToAlloc shr 10, 'kb: ', DosMaxAvail shr 10, 'kb.');π MemoryBlock := MemAlloc(MemToAlloc);π WriteLn('Dos free memory after allocating ',π MemToAlloc shr 10, 'kb: ', DosMaxAvail shr 10, 'kb.');π { if MemoryBlock = nil then report an error... }π MemFree(MemoryBlock)π end else WriteLn('Not enough memory. ',π (MemToAlloc - DosMaxAvail) shr 10, 'kb more needed.')πEnd.ππ 7 08-24-9413:55ALL PETER SAWATZKI RTM Functions SWAG9408 ≤ü< 103 ä▒ Unit RtmApi;π{ Import unit for all new functions in RTM 1.5π written 06/20/94 by Peter Sawatzki }πInterfaceπUsesπ WinTypes;ππprocedure FatalExit(Code: Integer);πfunction GetVersion: LongInt;πfunction LocalInit(Segment, Start, EndPos: Word): Bool;πfunction LocalAlloc(Flags, Bytes: Word): THandle;πfunction LocalReAlloc(Mem: THandle; Bytes, Flags: Word): THandle;πfunction LocalFree(Mem: THandle): THandle;πfunction LocalLock(Mem: THandle): Pointer;πfunction LocalUnlock(Mem: THandle): Bool;πfunction LocalSize(Mem: THandle): Word;πfunction LocalHandle(Mem: Word): THandle;πfunction LocalFlags(Mem: THandle): Word;πfunction LocalCompact(MinFree: Word): Word;πfunction LocalDiscard(Mem: THandle): THandle;π{function LocalNotify(NotifyProc: TFarProc): TFarProc;}πfunction GlobalAlloc(Flags: Word; Bytes: LongInt): THandle;πfunction GlobalReAlloc(Mem: THandle; Bytes: LongInt; Flags: Word): THandle;πfunction GlobalFree(Mem: THandle): THandle;πfunction GlobalLock(Mem: THandle): Pointer;πfunction GlobalUnlock(Mem: THandle): Bool;πfunction UnlockResource(ResData: THandle): Bool;πfunction GlobalSize(Mem: THandle): LongInt;πfunction GlobalHandle(Mem: Word): LongInt;πfunction GlobalFlags(Mem: THandle): Word;πfunction LockSegment(Segment: Word): THandle;πfunction UnlockSegment(Segment: Word): THandle;πfunction GlobalCompact(MinFree: LongInt): LongInt;πfunction GetCurrentTask: THandle;πfunction GetModuleUsage(Module: THandle): Integer;πfunction GetModuleFileName(Module: THandle; Filename: PChar; Size: Integer): Integer;πfunction GetModuleHandle(ModuleName: PChar): THandle;πfunction GetProcAddress(Module: THandle; ProcName: PChar): TFarProc;πfunction Catch(var CatchBuf: TCatchBuf): Integer;πprocedure Throw(var CatchBuf: TCatchBuf; ThrowBack: Integer);πfunction GetProfileInt(AppName, KeyName: PChar; Default: Integer): Word;πfunction GetProfileString(AppName, KeyName, Default, ReturnedString: PChar; Size: Integer): Integer;πfunction WriteProfileString(ApplicationName, KeyName, Str: PChar): Bool;πfunction FindResource(Instance: THandle; Name, ResType: PChar): THandle;πfunction LoadResource(Instance: THandle; ResInfo: THandle): THandle;πfunction LockResource(ResData: THandle): Pointer;πfunction FreeResource(ResData: THandle): Bool;πfunction AccessResource(Instance, ResInfo: THandle): Integer;πfunction SizeofResource(Instance, ResInfo: THandle): LongInt;πfunction OpenFile(FileName: PChar; var ReOpenBuff: TOfStruct; Style: Word): Integer;πfunction _lclose(FileHandle: Integer): Integer;πfunction _lread(FileHandle: Integer; Buffer: PChar; Bytes: Integer): Word;πfunction _lcreat(PathName: PChar; Atribute: Integer): Integer;πfunction _llseek(FileHandle: Integer; Offset: LongInt; Origin: Integer): LongInt;πfunction _lopen(PathName: PChar; ReadWrite: Integer): Integer;πfunction _lwrite(FileHandle: Integer; Buffer: PChar; Bytes: Integer): Word;πfunction LoadLibrary(LibFileName: PChar): THandle;πprocedure FreeLibrary(LibModule: THandle);πprocedure DOS3Call;πprocedure OutputDebugString(OutputString: PChar);πfunction LocalShrink(Seg: THandle; Size: Word): Word;πfunction GetPrivateProfileInt(ApplicationName, KeyName: PChar;π Default: Integer; FileName: PChar): Word;πfunction GetPrivateProfileString(ApplicationName, KeyName: PChar;π Default: PChar; ReturnedString: PChar;π Size: Integer; FileName: PChar): Integer;πfunction WritePrivateProfileString(ApplicationName, KeyName, Str, FileName: PChar): Bool;πfunction GetDOSEnvironment: PChar;πfunction GetWinFlags: LongInt;πFunction GetExePtr (aHandle: tHandle): tHandle;πfunction GetWindowsDirectory(Buffer: PChar; Size: Word): Word;πfunction GetSystemDirectory(Buffer: PChar; Size: Word): Word;πprocedure GlobalNotify(NotifyProc: TFarProc);πfunction GlobalLRUOldest(Mem: THandle): THandle;πfunction GlobalLRUNewest(Mem: THandle): THandle;πfunction GetFreeSpace(Flag: Word): LongInt;πfunction AllocDStoCSAlias(Selector: Word): Word;πfunction AllocSelector(Selector: Word): Word;πfunction FreeSelector(Selector: Word): Word;πfunction ChangeSelector(DestSelector, SourceSelector: Word): Word;πfunction GlobalDosAlloc(Bytes: LongInt): LongInt;πfunction GlobalDosFree(Selector: Word): Word;πfunction GlobalPageLock(Selector: THandle): Word;πfunction GlobalPageUnlock(Selector: THandle): Word;πprocedure GlobalFix(Mem: THandle);πfunction GlobalUnfix(Mem: THandle): Bool;πfunction AnsiUpper(Str: PChar): PChar;πfunction AnsiLower(Str: PChar): PChar;πfunction PrestoChangoSelector(SourceSel, DestSel: Word): Word;πfunction GetSelectorBase(Selector: Word): Longint;πfunction SetSelectorBase(Selector: Word; Base: Longint): Word;πfunction GetSelectorLimit(Selector: Word): Longint;πfunction SetSelectorLimit(Selector: Word; Base: Longint): Word;πfunction LockData(Dummy: Integer): THandle;πfunction UnlockData(Dummy: Integer): THandle;πfunction GlobalDiscard(Mem: THandle): THandle;ππ{USER}πfunction MessageBox(WndParent: HWnd; Txt, Caption: PChar; TextType: Word): Integer;πfunction GetTickCount: LongInt;πfunction GetCurrentTime: LongInt;πfunction LoadString(Instance: THandle; ID: Word; Buffer: PChar; BufferMax: Integer): Integer;πfunction _wsprintf(DestStr, Format: PChar; var ArgList): Integer; CDecl;ππ{KEYBOARD}πfunction AnsiToOem(AnsiStr, OemStr: PChar): Integer;πprocedure AnsiToOemBuff(AnsiStr, OemStr: PChar; Length: Integer);πfunction OemToAnsi(OemStr, AnsiStr: PChar): Bool;πprocedure OemToAnsiBuff(OemStr, AnsiStr: PChar; Length: Integer);ππImplementationππfunction _LocalLock(Mem: THandle): Word; far; forward;ππprocedure FatalExit; external 'KERNEL' Index 1;πfunction GetVersion; external 'KERNEL' Index 3;πfunction LocalInit; external 'KERNEL' Index 4;πfunction LocalAlloc; external 'KERNEL' Index 5;πfunction LocalReAlloc; external 'KERNEL' Index 6;πfunction LocalFree; external 'KERNEL' Index 7;πfunction _LocalLock; external 'KERNEL' Index 8;πfunction LocalUnlock; external 'KERNEL' Index 9;πfunction LocalSize; external 'KERNEL' Index 10;πfunction LocalHandle; external 'KERNEL' Index 11;πfunction LocalFlags; external 'KERNEL' Index 12;πfunction LocalCompact; external 'KERNEL' Index 13;π{function LocalNotify; external 'KERNEL' Index 14;}πfunction GlobalAlloc; external 'KERNEL' Index 15;πfunction GlobalReAlloc; external 'KERNEL' Index 16;πfunction GlobalFree; external 'KERNEL' Index 17;πfunction GlobalLock; external 'KERNEL' Index 18;πfunction GlobalUnlock; external 'KERNEL' Index 19;πfunction UnlockResource; external 'KERNEL' Index 19;πfunction GlobalSize; external 'KERNEL' Index 20;πfunction GlobalHandle; external 'KERNEL' Index 21;πfunction GlobalFlags; external 'KERNEL' Index 22;πfunction LockSegment; external 'KERNEL' Index 23;πfunction UnlockSegment; external 'KERNEL' Index 24;πfunction GlobalCompact; external 'KERNEL' Index 25;πfunction GetCurrentTask; external 'KERNEL' Index 36;πfunction GetModuleHandle; external 'KERNEL' Index 47;πfunction GetModuleUsage; external 'KERNEL' Index 48;πfunction GetModuleFileName; external 'KERNEL' Index 49;πfunction GetProcAddress; external 'KERNEL' Index 50;πfunction Catch; external 'KERNEL' Index 55;πprocedure Throw; external 'KERNEL' Index 56;πfunction GetProfileInt; external 'KERNEL' Index 57;πfunction GetProfileString; external 'KERNEL' Index 58;πfunction WriteProfileString; external 'KERNEL' Index 59;πfunction FindResource; external 'KERNEL' Index 60;πfunction LoadResource; external 'KERNEL' Index 61;πfunction LockResource; external 'KERNEL' Index 62;πfunction FreeResource; external 'KERNEL' Index 63;πfunction AccessResource; external 'KERNEL' Index 64;πfunction SizeofResource; external 'KERNEL' Index 65;πfunction OpenFile; external 'KERNEL' Index 74;πfunction _lclose; external 'KERNEL' Index 81;πfunction _lread; external 'KERNEL' Index 82;πfunction _lcreat; external 'KERNEL' Index 83;πfunction _llseek; external 'KERNEL' Index 84;πfunction _lopen; external 'KERNEL' Index 85;πfunction _lwrite; external 'KERNEL' Index 86;πfunction LoadLibrary; external 'KERNEL' Index 95;πprocedure FreeLibrary; external 'KERNEL' Index 96;πprocedure DOS3Call; external 'KERNEL' Index 102;πprocedure OutputDebugString; external 'KERNEL' Index 115;πfunction LocalShrink; external 'KERNEL' Index 121;πfunction GetPrivateProfileInt; external 'KERNEL' Index 127;πfunction GetPrivateProfileString; external 'KERNEL' Index 128;πfunction WritePrivateProfileString; external 'KERNEL' Index 129;πfunction GetDOSEnvironment; external 'KERNEL' Index 131;πfunction GetWinFlags; external 'KERNEL' Index 132;πfunction GetExePtr; external 'KERNEL' Index 133;πfunction GetWindowsDirectory; external 'KERNEL' Index 134;πfunction GetSystemDirectory; external 'KERNEL' Index 135;πprocedure GlobalNotify; external 'KERNEL' Index 154;πfunction GlobalLRUOldest; external 'KERNEL' Index 163;πfunction GlobalLRUNewest; external 'KERNEL' Index 164;πfunction GetFreeSpace; external 'KERNEL' Index 169;πfunction AllocDStoCSAlias; external 'KERNEL' Index 171;πfunction AllocSelector; external 'KERNEL' Index 175;πfunction FreeSelector; external 'KERNEL' Index 176;πfunction ChangeSelector; external 'KERNEL' Index 177;πfunction GlobalDosAlloc; external 'KERNEL' Index 184;πfunction GlobalDosFree; external 'KERNEL' Index 185;πfunction GlobalPageLock; external 'KERNEL' Index 191;πfunction GlobalPageUnlock; external 'KERNEL' Index 192;πprocedure GlobalFix; external 'KERNEL' Index 197;πfunction GlobalUnfix; external 'KERNEL' Index 198;πfunction AnsiUpper; external 'KERNEL' Index 431;πfunction AnsiLower; external 'KERNEL' Index 432;πfunction PrestoChangoSelector; external 'KERNEL' Index 177;πfunction GetSelectorBase; external 'KERNEL' Index 186;πfunction SetSelectorBase; external 'KERNEL' Index 187;πfunction GetSelectorLimit; external 'KERNEL' Index 188;πfunction SetSelectorLimit; external 'KERNEL' Index 189;ππfunction MessageBox; external 'USER' Index 1;πfunction GetTickCount; external 'USER' Index 13;πfunction GetCurrentTime; external 'USER' Index 15;πfunction LoadString; external 'USER' Index 176;πfunction _wsprintf; external 'USER' Index 420;ππfunction AnsiToOem; external 'KEYBOARD' Index 5;πfunction OemToAnsi; external 'KEYBOARD' Index 6;πprocedure AnsiToOemBuff; external 'KEYBOARD' Index 134;πprocedure OemToAnsiBuff; external 'KEYBOARD' Index 135;ππ{ Various wrapper routines }ππfunction LockData(Dummy: Integer): THandle;πbeginπ LockData := LockSegment($FFFF);πend;ππfunction UnlockData(Dummy: Integer): THandle;πbeginπ UnlockData := UnlockSegment($FFFF);πend;ππfunction GlobalDiscard(Mem: THandle): THandle;πbeginπ GlobalDiscard := GlobalReAlloc(Mem, 0, gmem_Moveable);πend;ππfunction LocalDiscard(Mem: THandle): THandle;πbeginπ LocalDiscard := LocalReAlloc(Mem, 0, lmem_Moveable);πend;ππfunction LocalLock(Mem: THandle): Pointer; assembler;πasmπ PUSH Memπ CALL _LocalLockπ MOV DX,DSπend;ππEnd.π 8 08-24-9413:58ALL JACK NOMSSI Free Stack Space SWAG9408
j\5 17 ä▒ {πHere is some code I use to find out how many stack space is used after aπrun. I guess it won't work in protected mode. Be awareπit isn't byte-resolution ! I'd like to hear about enhancements.π}ππunit Stack;πinterfaceπ procedure InitStack;π procedure TestStack;πimplementationππ(*πRoutinen zum Pruefen des StackbedarfsπWilfried F?rber, Isar Software GmbHπRingeisstr. 2a, 8000 Muenchen 2πAugust 1991ππRoutinen zum Pruefen, wieviel Stack wirklich benoetigt wird.πWillfried F?rber, Isar Software GmbH, August 1991πPort von C nach Pascal: Jacques NOMSSI NZALI,πemail: nomssi@physikus.physik.tu-chemnitz.deπ*)πVar STKHQQ : word;ππconstπ stacktext : packed array[1..4] of char = 'STAC';π MAXSTACK = (1024 div 4)*64;ππfunction atopsp : Word; assembler;πasmπ mov ax, spπend;ππprocedure InitStack;πvarπ AktStack,π Anzahl : Word;πbeginπ STKHQQ := StackLimit;π asmπ mov AktStack, bpπ end;π Anzahl := (AktStack - STKHQQ) div 4;π asmπ mov cx, [Anzahl]π mov di, [STKHQQ]π mov ax, ssππ mov es, axπ mov ax, Offset StackTextπ @L1:π mov si, axπ movswπ movswπ loop @L1π end;πend;ππfunction StackSize : Word;πbeginπ StackSize := - STKHQQ + atopsp;πend;ππfunction StackUsed : Word;πvarπ StackFrei,π StackMax : Word;πBeginπ StackMax := StackSize;π asmπ mov cx, MAXSTACKπ mov di, [STKHQQ]π mov ax, ssππ mov es, axπ mov ax, Offset Stacktextπ @L1:π mov si, axπ cmpswπ jnz @L2π cmpswπ loope @L1π @L2:π sub cx, MAXSTACKπ not cxπ mov [StackFrei], cxπ end;π StackFrei := StackFrei*4;π StackUsed := StackMax - StackFrei;πend;ππprocedure TestStack;πvarπ StackVerb, _MaxStack : Word;πbeginπ _MaxStack := StackSize;π StackVerb := StackUsed;π WriteLn('STACK-VERBRAUCHSTEST ---------------------- ');π WriteLn('Programmstack :', _MaxStack);π WriteLn('Es wurden ca. ',StackVerb,' Bytes benoetigt.');π WriteLn('Stack-Reserve :',MaxStack-StackVerb,' Bytes.');π ReadLn;πend;ππbeginπ InitStack;πend.π 9 08-24-9417:56ALL ROBERT ROTHENBUR 386 copy/move SWAG9408 R|⌠W 20 ä▒ {πI wrote some substitutes for Move and Copy in Turbo Pascal 7.0 that useπ386-instructions (sort of). Some initial tests showed 30-40% improve-πment in speed.ππI am posting these here for the public domain, and hance I make noπguarantees for how well they work. If you find bugs or make anyπoptimizations, drop me a line...π}ππ(* XFUNC.PAS v0.01 by Robert Rothenburg Walking-Owl, June 1, 1994 *)π(* 32-bit "X-Functions" for Turbo Pascal 7.0 *)ππ{$DEFINE USE386}ππ{ if you $UNDEF USE386, normal 8086 instructions will be used; thisπ way the only change that needs to be made if you want to write '86π and '386 versions is to recompile this unit with the appropriateπ define... }ππunit XFunc;ππinterfaceππprocedure XMove(var source, dest; size: word);πfunction XCopy(source: string; soffs, size: byte): string;ππimplementationππ { Works the same as Move(source,dest,size); }ππprocedure XMove(var source, dest; size: word); assembler;πasmπ push dsπ push esπ lds si, sourceπ les di, destπ mov cx, sizeπ cldπ shr cx, 1π jnc @word1π movsbπ@word1:π{$IFDEF USE386}π shr cx, 1π jnc @word2π movswπ@word2: db 0f3h, 066h, 0a5h { rep movsd }π{$ELSE}π rep movswπ{$ENDIF}π pop esπ pop dsπend;ππ { works the same as Copy(str, index, len); }πππfunction XCopy(source: string; soffs, size: byte): string; assembler;πasmπ push dsπ push esπ lds si, sourceπ les di, @resultπ xor ax, axπ mov bx, axπ mov cx, axπ mov bl, soffsπ mov cl, sizeπ cldπ stosbπ lodsbπ cmp ax, bxπ jb @doneπ add si, bxπ dec siπ sub ax, bxπ cmp ax, cxπ jnb @docopπ xchg ax, cxπ inc cxπ@docop: push cxπ shr cx, 1π jnc @word1π movsbπ@word1:π{$IFDEF USE386}π shr cx, 1π jnc @word2π movswπ@word2: db 0f3h, 066h, 0a5h { rep movsd }π{$ELSE}π rep movswπ{$ENDIF}π pop axπ les di, @resultπ stosbπ@done:π pop esπ pop dsπend;ππend.ππ 10 08-24-9417:56ALL ANDREW EIGUS XMS Library SWAG9408 ■_b 221 ä▒ πUnit XMSLib;π{ XMSLIB V2.02 Copyright (c) 1994 by Andrew Eigus Fido Net: 2:5100/33 }π{ XMS Interface for Turbo Pascal version 7.0 }ππ(*π XMS termines:ππ XMS: eXtended Memory Specificationπ XMS gives access to extended memory and noncontiguous/nonEMSπ memory above 640Kπ UMB: Upper Memory Blockπ HMA: High Memory Areaππ Material used:ππ C and ASM source of XMS Library (c) by Michael Graff,π eXtended Memory Specification unit source (c) by Yuval Tal,π Interrupt List V1.02 (WindowBook) (c) 1984-90 Box Company, Inc.π*)ππinterfaceππconstππ { XMS function numbers }ππ XGetVersion = $00;π XRequestHMA = $01;π XReleaseHMA = $02;π XGlobalE20 = $03;π XGlobalD20 = $04;π XLocalE20 = $05;π XLocalD20 = $06;π XQuery20 = $07;π XGetMemSize = $08;π XAllocEMB = $09;π XFreeEMB = $0A;π XMoveEMB = $0B;π XLockEMB = $0C;π XUnlockEMB = $0D;π XGetHandleInfo = $0E;π XReallocEMB = $0F;π XRequestUMB = $10;π XReleaseUMB = $11;ππ { XMS_GetVersion parameters }ππ XMS = True; { Get XMS version }π XMM = False; { Get XMM version }ππ { XMS functions return codes }ππ xmsrOk = $00; { Function successful }π xmsrNotInitd = $01; { XMS driver not initialized by XMS_Setup }π xmsrBadFunction = $80; { Function not implemented }π xmsrVDiskDetected = $81; { VDisk was detected }π xmsrA20Error = $82; { An A20 error occurred }π xmsrDriverError = $8E; { A general driver error }π xmsrUnrecError = $8F; { Unrecoverable driver error }π xmsrNoHMA = $90; { HMA does not exist }π xmsrHMAInUse = $91; { HMA is already in use }π xmsrHMAMinError = $92; { HMAMIN parameter is too large }π xmsrHMANotAlloc = $93; { HMA is not allocated }π xmsrA20Enabled = $94; { A20 line still enabled }π xmsrNoMoreMem = $A0; { All extended memory is allocated }π xmsrNoMoreHandles = $A1; { All available XMS handles are allocated }π xmsrBadHandle = $A2; { Invalid handle }π xmsrBadSourceH = $A3; { Source handle is invalid }π xmsrBadSourceO = $A4; { Source offset is invalid }π xmsrBadDestH = $A5; { Destination handle is invalid }π xmsrBadDestO = $A6; { Destination offset is invalid }π xmsrBadLength = $A7; { Length (size) is invalid }π xmsrBadOverlap = $A8; { Move has an invalid overlap }π xmsrParityError = $A9; { Parity error occurred }π xmsrBlkNotLocked = $AA; { Block is not locked }π xmsrBlkLocked = $AB; { Block is locked }π xmsrBlkLCOverflow = $AC; { Block lock count overflowed }π xmsrLockFailed = $AD; { Lock failed }π xmsrSmallerUMB = $B0; { Only a smaller UMB is available }π xmsrNoUMB = $B1; { No UMB's are available }π xmsrBadUMBSegment = $B2; { UMB segment number is invalid }ππtypeπ THandle = Word; { Memory block handle type }ππvarπ XMSResult : byte; { Returns the status of the last XMS operation performed }πππfunction XMS_Setup : boolean;π{ This function returns True is the extended memory manager device driverπ is installed in memory and active. True if installed, False if notπ installed. You should call this function first, before any other areπ called so it will setup memory manager for use with your program }ππfunction XMS_GetVersion(OfWhat : boolean) : word;π{ This function returns eighter the version of the extended memoryπ specifications version, or the version of the extended memory managerπ device driver version, depends on what you're using as an OfWhatπ parameter (see XMS_GetVersion parameters in const section of the unit).π The result's low byte is the major version number, and the high byte isπ the minor version number }ππfunction XMS_HMAAvail : boolean;π{ This function obtains the status of the high memory area (HMA).π If the result is true, HMA exists. If the result is False no HMA exists }ππfunction XMS_AllocHMA(Size : word) : byte;π{ This function allocates high memory area (HMA). Size contains the theπ bytes which are needed. The maximum HMA allocation is 65520 bytes.π The base address of the HMA is FFFF:0010h. If an application failsπ to release the HMA before it terminates, the HMA becomes unavailableπ to the other programs until the system is restarted. Function returnsπ zero (xmsrOk) if the call was successful, or one of the xmsr-error codesπ if the call has failed }ππfunction XMS_FreeHMA : byte;π{ This function releases the high memory area (HMA) and returns zero ifπ the call was successful, or one of the xmsr-error codes if the call hasπ failed }ππfunction XMS_GlobalEnableA20 : byte;π{ This function enables the A20 line and should only be used by programsπ that have successfully allocated the HMA. The result is zero if theπ call was successful, otherwise, the result is one of the (xmsr)π return values }ππfunction XMS_GlobalDisableA20 : byte;π{ This function disables the A20 line and should only be used by programsπ that do not own the HMA. The result is zero if the call was successful,π otherwise, the result is one of the (xmsr) return values }ππfunction XMS_LocalEnableA20 : byte;π{ This function enables the A20 line and should only be used by programsπ that have successfully allocated the HMA. The result is zero if the callπ was successful, otherwise, the result is one of the (xmsr) return values }ππfunction XMS_LocalDisableA20 : byte;π{ This function disables the A20 line and should only be used by programsπ that do not own the HMA. The A20 line should be disabled before the programπ releases control of the system. The result is zero if the call wasπ successful, otherwise, the result is one of the (xmsr) return values }ππfunction XMS_QueryA20 : boolean;π{ This function returns the status of the A20 address line. If the result isπ True then the A20 line is enabled. If False, it is disabled }ππfunction XMS_MemAvail : word;π{ This function returns the total free extended memory in kilo-bytes }ππfunction XMS_MaxAvail : word;π{ This function returns the largest free extended memory block in kilo-bytes }ππfunction XMS_AllocEMB(Size : word) : THandle;π{ This function allocates extended memory block (EMB). Size defines the sizeπ of the requested block in kilo-bytes. Function returns a handle numberπ which is used by the other EMB commands to refer to this block. If the callπ to this function was unsuccessful, zero is returned instead of the handleπ number and (xmsr) error code is stored in XMSResult variable }ππfunction XMS_ReallocEMB(Handle : THandle; Size : word) : byte;π{ This function reallocates EMB. Handle is a handle number which was givenπ by XMS_AllocEMB. Size defines a new size of the requested block inπ kilo-bytes. Function returns zero if the call was successful, orπ a (xmsr) error code if it failed }ππfunction XMS_FreeEMB(Handle : THandle) : byte;π{ This function releases allocated extended memory. Handle is a handle numberπ which was given by XMS_AllocEMB. Note: If a program fails to release itsπ extended memory before it terminates, the memory becomes unavailable toπ other programs until the system is restarted. Blocks may not be releasedπ while they are locked. Function returns zero if the call was successful, orπ a (xmsr) error code if the call has failed }ππfunction XMS_MoveFromEMB(Handle : THandle; var Dest; Count : longint) : byte;π{ This function moves data from the extended memory to the conventionalπ memory. Handle is a handle number given by XMS_AllocEMB. Dest is a non-typedπ variable so any kind of data can be written there. Count is the number ofπ bytes which should be moved. The state of the A20 line is preserved.π Function returns zero if the call was successful, or a (xmsr) error codeπ if the call has failed }ππfunction XMS_MoveToEMB(Handle : THandle; var Source; Count : longint) : byte;π{ This function moves data from the conventional memory to the extendedπ memory. Handle is a handle number given by XMS_AllocEMB. Source is aπ non-typed variable so any kind of data can be written there. Count isπ the number of bytes which should be moved. The state of the A20 line isπ preserved. Function returns zero if the call was successful, or aπ (xmsr) error code if the call has failed }ππfunction XMS_LockEMB(Handle : THandle) : pointer;π{ This function locks a specified EMB. This function is intended for use byπ programs which enable the A20 line and access extended memory directly.π Handle is a handle number given by XMS_AllocEMB. The result is a 32-bitπ linear address of the locked block or NIL if lock did not succeed. Theπ result value is stored in XMSResult variable }ππfunction XMS_UnlockEMB(Handle : THandle) : byte;π{ This function unlocks previously locked blocks (by XMS_LockEMB). Afterπ the EMB is unlocked the 32-bit pointer returned by XMS_LockEMB becomesπ invalid and should not be used. Handle is a handle number given byπ XMS_AllocEMB. The result value is zero if the call was successful,π otherwise it is one of the (xmsr) return codes }ππfunction XMS_EMBHandlesAvail(Handle : THandle) : byte;π{ This function returns the number of free handles which are available toπ your program. Handle is a handle number given by XMS_AllocEMB. The resultπ value is stored in XMSResult variable }ππfunction XMS_EMBLockCount(Handle : THandle) : byte;π{ This function returns the lock count of a specified EMB. Handle is a handleπ number given by XMS_AllocEMB. If the function returns zero it means thatπ the block is not locked. The result value is stored in XMSResult variable }ππfunction XMS_EMBSize(Handle : THandle) : word;π{ This function determines the size of a specified EMB. Handle is a handleπ number given by XMS_AllocEMB. The result is the size of the block inπ kilo-bytes. The result code is stored in XMSResult variable }ππfunction XMS_AllocUMB(Size : word) : longint;π{ This function allocates upper memory blocks (UMBs). Size is the size ofπ the block in paragraphs.π Function returns:π - segment base of the allocated block in the low-order wordπ - actual block size in paragraphs in the high-order wordπ In case of an error the high-order word will be the size of the largestπ available block in paragraphs.π The result code is stored in XMSResult variable }ππfunction XMS_FreeUMB(Segment : word) : byte;π{ This function releases the memory that was allocated by XMS_FreeUMB.π Segment must contain the segment base of the block which must beπ released. The result value is zero if the call was successful, orπ one of the (xmsr) error codes, otherwise }ππfunction XMS_GetErrorMsg(ErrorCode : byte) : string;π{ This function translates the error code which is returned by all theπ XMS_ functions in the unit from a number to a string. The error code isπ written to the global variable XMSResult (byte). If XMSResult is equalπ to zero then no errors were encountered. For more information aboutπ the result codes, see (xmsr) constants in the unit's const section }πππimplementationππtypeπ TransferRec = recordπ TransferSize : longint;π SourceHandle : THandle;π SourceOffset : longint;π DestHandle : THandle;π DestOffset : longintπ end;ππvarπ XMSInitd : boolean;π XMSDriver : procedure;π TR : TransferRec; { Internal transfer EMB structure }ππFunction XMS_Setup; assembler;πAsmπ MOV [XMSInitd],Falseπ MOV AX,4300h { XMS Driver installation check }π INT 2Fhπ CMP AL,80hπ JE @@1 { XMS found }π MOV AL,False { else XMS manager not found }π JMP @@2π@@1:π MOV AX,4310h { Get address of XMS driver }π INT 2Fhπ MOV WORD [XMSDriver],BX { store offset }π MOV WORD [XMSDriver+2],ES { store segment }π INC [XMSInitd] { we have init'd our code }π MOV AL,Trueπ@@2:πEnd; { XMS_Setup }ππFunction XMS_GetVersion; assembler;πAsmπ MOV [XMSResult],xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV AH,XGetVersion { Function to get version }π CALL [XMSDriver] { Call the XMS driver }π MOV [XMSResult],xmsrOkπ CMP OfWhat,XMS { XMS or XMM version? }π JE @@1 { If XMS, it's already in AX }π MOV AX,BX { If XMM, it's in BX, so move it to AX }π@@1:πEnd; { XMS_GetVersion }ππFunction XMS_HMAAvail; assembler;πAsmπ MOV [XMSResult],xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV AH,XGetVersion { Function number }π CALL [XMSDriver]π MOV [XMSResult],xmsrOkπ MOV AL,DL { Store result value }π@@1:πEnd; { XMS_HMAAvail }ππFunction XMS_AllocHMA; assembler;πAsmπ MOV BL,xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV DX,Size { Ammount of HMA wanted }π MOV AH,XRequestHMA { Function to allocate HMA }π CALL [XMSDriver] { Call the XMS driver }π OR AX,AXπ JZ @@1π XOR BL,BL { No error }π@@1:π MOV AL,BL { Store result value }π MOV [XMSResult],BL { Save error code }πEnd; { XMS_AllocHMA }ππFunction XMS_FreeHMA; assembler;πAsmπ MOV BL,xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV AH,XReleaseHMA { Function to release HMA }π CALL [XMSDriver] { Call the XMS driver }π OR AX,AXπ JZ @@1 { If error then jump, else }π XOR BL,BL { clear error code }π@@1:π MOV AL,BLπ MOV [XMSResult],BL { Get return code in XMSResult }πEnd; { XMS_FreeHMA }ππFunction XMS_GlobalEnableA20; assembler;πAsmπ MOV BL,xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV AH,XGlobalE20 { Function code }π CALL [XMSDriver] { Call the XMS driver }π OR AX,AXπ JZ @@1π XOR BL,BL { Return no error }π@@1:π MOV AL,BLπ MOV [XMSResult],BL { Store result value }πEnd; { XMS_GlobalEnableA20 }ππFunction XMS_GlobalDisableA20; assembler;πAsmπ MOV BL,xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV AH,XGlobalD20 { Function code }π CALL [XMSDriver] { Call the XMS driver }π OR AX,AXπ JZ @@1π XOR BL,BL { Return success }π@@1:π MOV AL,BLπ MOV [XMSResult],BL { Store result value }πEnd; { XMS_GlobalDisableA20 }ππFunction XMS_LocalEnableA20; assembler;πAsmπ MOV BL,xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV AH,XLocalE20 { Function code }π CALL [XMSDriver] { Call the XMS driver }π OR AX,AXπ JZ @@1π XOR BL,BL { Return no error value }π@@1:π MOV AL,BLπ MOV [XMSResult],BL { Store result value }πEnd; { XMS_LocalEnableA20 }ππFunction XMS_LocalDisableA20; assembler;πAsmπ MOV BL,xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV AH,XLocalD20 { Function code }π CALL [XMSDriver] { Call the XMS driver }π OR AX,AXπ JZ @@1π XOR BL,BL { Return no error }π@@1:π MOV AL,BLπ MOV [XMSResult],BL { Save result }πEnd; { XMS_LocalDisableA20 }ππFunction XMS_QueryA20; assembler;πAsmπ MOV BL,xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV AH,XQuery20 { Function code }π CALL [XMSDriver] { Call the XMS driver; result in AL }π@@1:π MOV [XMSResult],BL { Store error code value }πEnd; { XMS_QueryA20 }ππFunction XMS_MemAvail; assembler;πAsmπ MOV BL,xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV AH,XGetMemSize { Function code }π CALL [XMSDriver] { Call the XMS driver }π MOV AX,DX { AX=Get XMS memory available in K-bytes }π@@1:π MOV [XMSResult],BL { Store result value }πEnd; { XMS_MemAvail }ππFunction XMS_MaxAvail; assembler;πAsmπ MOV BL,xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV AH,XGetMemSize { Function code }π CALL [XMSDriver] { Call the XMS driver }π { AX=Get XMS maximum memory block available in K-bytes }π@@1:π MOV [XMSResult],BL { Store result value }πEnd; { XMS_MaxAvail }ππFunction XMS_AllocEMB; assembler;πAsmπ MOV BL,xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@2π MOV AH,XAllocEMB { Function code }π MOV DX,Size { Number of K-Bytes to allocate }π CALL [XMSDriver] { Call the XMS driver }π OR AX,AXπ JZ @@1π MOV AX,DX { Store handle number in AX }π XOR BL,BL { Set no error }π JMP @@2π@@1:π XOR AX,AX { Return handle 0 if error }π@@2:π MOV [XMSResult],BLπEnd; { XMS_AllocEMB }ππFunction XMS_ReallocEMB; assembler;πAsmπ MOV BL,xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV AH,XReallocEMB { Function code }π MOV DX,Handle { Handle number }π MOV BX,Size { New size wanted in K-Bytes }π CALL [XMSDriver] { Call the XMS driver }π OR AX,AXπ JZ @@1π XOR BL,BL { There's no error }π@@1:π MOV AL,BL { Return result value }π MOV [XMSResult],BL { Store error code }πEnd; { XMS_ReallocEMB }ππFunction XMS_FreeEMB; assembler;πAsmπ MOV BL,xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV AH,XFreeEMB { Function code }π MOV DX,Handle { Set handle number in DX }π CALL [XMSDriver] { Call the XMS driver }π OR AX,AXπ JZ @@1π XOR BL,BL { No error }π@@1:π MOV AL,BL { Return result value }π MOV [XMSResult],BL { Store error code }πEnd; { XMS_FreeEMB }ππFunction XMS_MoveFromEMB; assembler;πAsmπ PUSH DSπ MOV BL,xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV CX,WORD PTR [Count]π MOV TR.WORD PTR [TransferSize],CXπ MOV CX,WORD PTR [Count+2]π MOV TR.WORD PTR [TransferSize+2],CXπ MOV CX,Handleπ MOV TR.SourceHandle,CXπ MOV WORD PTR [TR.SourceOffset],0π MOV WORD PTR [TR.SourceOffset+2],0π MOV TR.DestHandle,0π LES SI,Destπ MOV WORD PTR [TR.DestOffset],SIπ MOV WORD PTR [TR.DestOffset+2],ESπ MOV AH,XMoveEMBπ MOV DX,SEG TRπ MOV DS,DXπ MOV SI,OFFSET TRπ CALL [XMSDriver]π OR AX,AXπ JZ @@1π XOR BL,BLπ@@1:π MOV AL,BLπ MOV [XMSResult],BLπ POP DSπEnd; { XMS_MoveFromEMB }ππFunction XMS_MoveToEMB; assembler;πAsmπ PUSH DSπ MOV BL,xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV CX,WORD PTR [Count]π MOV TR.WORD PTR [TransferSize],CXπ MOV CX,WORD PTR [Count+2]π MOV TR.WORD PTR [TransferSize+2],CXπ MOV TR.SourceHandle,0π LES SI,Sourceπ MOV WORD PTR [TR.SourceOffset],SIπ MOV WORD PTR [TR.SourceOffset+2],ESπ MOV CX,Handleπ MOV TR.DestHandle,CXπ MOV WORD PTR [TR.DestOffset],0π MOV WORD PTR [TR.DestOffset+2],0π MOV AH,XMoveEMBπ MOV DX,SEG TRπ MOV DS,DXπ MOV SI,OFFSET TRπ CALL [XMSDriver]π OR AX,AXπ JZ @@1π XOR BL,BLπ@@1:π MOV AL,BLπ MOV [XMSResult],BLπ POP DSπEnd; { XMS_MoveToEMB }ππFunction XMS_LockEMB; assembler;πAsmπ CMP [XMSInitd],Trueπ JNE @@1 { if not initialized, return the NIL pointer }π MOV AH,XLockEMB { Function code }π MOV DX,Handle { Handle in DX }π CALL [XMSDriver] { Call the XMS driver }π OR AX,AX { Was the call successful? }π JNZ @@2 { Yep, so jump and return pointer }π@@1:π XOR AX,AXπ XOR DX,DX { Return NIL }π MOV [XMSResult],xmsrLockFailedπ JMP @@3π@@2:π MOV AX,BX { Offset in AX, Segment in DX }π MOV XMSResult,xmsrOkπ@@3:πEnd; { XMS_LockEMB }ππFunction XMS_UnlockEMB; assembler;πAsmπ MOV BL,xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV AH,XUnlockEMB { Function code }π MOV DX,Handle { Handle in DX }π CALL [XMSDriver] { Call the XMS driver }π OR AX,AXπ JZ @@1π XOR BL,BLπ@@1:π MOV AL,BLπ MOV [XMSResult],BLπEnd; { XMS_UnlockEMB }ππFunction XMS_EMBHandlesAvail; assembler;πAsmπ MOV BL,xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV AH,XGetHandleInfo { Function code }π MOV DX,Handleπ CALL [XMSDriver]π OR AX,AXπ JZ @@1π MOV AL,BL { Save number of free handles }π XOR BL,BLπ@@1:π MOV [XMSResult],BLπEnd; { XMS_EMBHandlesAvail }ππFunction XMS_EMBLockCount; assembler;πAsmπ MOV BL,xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV AH,XGetHandleInfoπ MOV DX,Handle { Handle in DX }π CALL [XMSDriver]π OR AX,AXπ JZ @@1π MOV AL,BH { Save lock count }π XOR BL,BLπ@@1:π MOV [XMSResult],BLπEnd; { XMS_EMBLockCount }ππFunction XMS_EMBSize; assembler;πAsmπ MOV BL,xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV AH,XGetHandleInfoπ MOV DX,Handleπ CALL [XMSDriver]π OR AX,AXπ JZ @@1π MOV AX,DX { Save EMB size in K-bytes }π XOR BL,BLπ@@1:π MOV [XMSResult],BLπEnd; { XMS_EMBSize }ππFunction XMS_AllocUMB; assembler;πAsmπ MOV BL,xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV AH,XRequestUMB { Function code }π MOV DX,Size { Number of paragraphs we want }π CALL [XMSDriver] { Call the XMS driver }π OR AX,AXπ JZ @@1π MOV AX,BX { Return segment of UMB in low-order word }π { Actual block size in high-order word }π XOR BL,BLπ@@1:π MOV [XMSResult],BLπEnd; { XMS_AllocUMB }ππFunction XMS_FreeUMB; assembler;πAsmπ MOV BL,xmsrNotInitdπ CMP [XMSInitd],Trueπ JNE @@1π MOV AH,XReleaseUMB { Function code }π MOV DX,Segment { Segment of UMB to release }π CALL [XMSDriver] { Call the XMS driver }π OR AX,AXπ JZ @@1π XOR BL,BLπ@@1:π MOV AL,BLπ MOV [XMSResult],BLπEnd; { XMS_FreeUMB }ππFunction XMS_GetErrorMsg;πvar S : ^String;πBeginπ New(S);π case ErrorCode ofπ xmsrNotInitd: S^ := 'XMS driver not initialized';π xmsrBadFunction: S^ := 'Function not implemented';π xmsrVDiskDetected: S^ := 'VDisk has detected';π xmsrA20Error: S^ := 'An A20 error occurred';π xmsrDriverError: S^ := 'A general driver error';π xmsrUnrecError: S^ := 'Unrecoverable driver error';π xmsrNoHMA: S^ := 'HMA does not exist';π xmsrHMAInUse: S^ := 'HMA is already in use';π xmsrHMAMinError: S^ := 'HMAMIN parameter is too large';π xmsrHMANotAlloc: S^ := 'HMA is not allocated';π xmsrA20Enabled: S^ := 'A20 line still enabled';π xmsrNoMoreMem: S^ := 'All extended memory is allocated';π xmsrNoMoreHandles: S^ := 'All available XMS handles are allocated';π xmsrBadHandle: S^ := 'Invalid block handle';π xmsrBadSourceH: S^ := 'Block source handle is invalid';π xmsrBadSourceO: S^ := 'Block source offset is invalid';π xmsrBadDestH: S^ := 'Block destination handle is invalid';π xmsrBadDestO: S^ := 'Block destination offset is invalid';π xmsrBadLength: S^ := 'Block length is invalid';π xmsrBadOverlap: S^ := 'Move operation has an invalid overlap';π xmsrParityError: S^ := 'Parity error';π xmsrBlkNotLocked: S^ := 'Block is not locked';π xmsrBlkLocked: S^ := 'Block is locked';π xmsrBlkLCOverflow: S^ := 'Block lock count overflowed';π xmsrLockFailed: S^ := 'Lock failed';π xmsrSmallerUMB: S^ := 'Too large UMB requested';π xmsrNoUMB: S^ := 'No UMB''s are available';π xmsrBadUMBSegment: S^ := 'UMB segment number is invalid';π else S^ := 'Unknown error'π end;π XMS_GetErrorMsg := S^;π Dispose(S)πEnd; { XMS_GetErrorMsg }ππBeginπ { Initialize global variables }π XMSInitd := False;π XMSResult := xmsrOkπEnd. { XMSLib }ππ{ ***** XMSDEMO.PAS ***** }ππProgram XMSLibDemo;π{ Copyright (c) 1994 by Andrew Eigus Fido Net: 2:5100/33 }π{ XMS Interface V2.02 for Turbo Pascal version 7.0 demonstration program }ππ(*π Tested on IBM 486 SX 33Mhz with 4MB RAM with the following configuration:π 1) HIMEM.SYS (MS-DOS 6.2 XMS memory manager)π 2) HIMEM.SYS (MS-DOS 6.2 XMS memory manager)π EMM386.EXE (MS-DOS 6.2 EMS memory manager)ππ If any inpredictable errors occur in your system while running this demo,π please be so kind to inform me:ππ AndRew's BBS Phone: 003-712-559777 (Riga, Latvia) 24h 2400bpsπ Voice Phone: 003-712-553218π Fido Net: 2:5100/20.12π*)ππ{X+}{$R-}ππuses XMSLib;ππtypeπ TMsg = array[1..14] of Char;ππ TUMBAllocRec = recordπ Size : word;π SegAddr : wordπ end;ππconstπ Message1 : TMsg = 'First message ';π Message2 : TMsg = 'Second message';ππ YesNo : array[boolean] of string[3] = ('No', 'Yes');π A20State : array[boolean] of string[8] = ('Disabled', 'Enabled');ππvarπ Version, Memory, Handle, BlockLength : word;π Locks, FreeHandles : byte;π HMAAvailable : boolean;π Address : pointer;π UMB : longint;ππFunction Hex(Num : longint; Places : byte) : string;πconst HexTab : array[0..15] of Char = '0123456789ABCDEF';πvarπ HS : string[8];π Digit : byte;πBeginπ HS[0] := Chr(Places);π for Digit := Places downto 1 doπ beginπ HS[Digit] := HexTab[Num and $0000000F];π Num := Num shr 4π end;π Hex := HSπEnd; { Hex }ππFunction Check(Result : byte; Func : string) : byte;πBeginπ if Result <> xmsrOk thenπ WriteLn(Func, ' returned ',π Hex(Result, 2), 'h (', Result, '): ', XMS_GetErrorMsg(Result));π Check := ResultπEnd; { Check }ππProcedure ShowA20State;πvar State : boolean;πBeginπ State := XMS_QueryA20;π if Check(XMSResult, 'XMS_QueryA20') = xmsrOk thenπ WriteLn('A20 state: ', A20State[State])πEnd; { ShowA20State }ππProcedure Wait4Return;πBeginπ WriteLn;π WriteLn('Press ENTER to continue');π ReadLnπend; { Wait4Return }πππBeginπ WriteLn('XMS Library V2.02 Demonstration program by Andrew Eigus'#10);π if XMS_Setup thenπ beginππ Version := XMS_GetVersion(XMS);π if Check(XMSResult, 'XMS_GetVersion(XMS)') = xmsrOk thenπ WriteLn('XMS version ', Hi(Version), '.', Lo(Version), ' present');π Version := XMS_GetVersion(XMM);π if Check(XMSResult, 'XMS_GetVersion(XMM)') = xmsrOk thenπ WriteLn('XMM version ', Hi(Version), '.', Lo(Version), ' detected');π HMAAvailable := XMS_HMAAvail;π if Check(XMSResult, 'XMS_HMAAvail') = xmsrOk thenπ WriteLn('HMA Available: ', YesNo[HMAAvailable]);ππ WriteLn;π Memory := XMS_MemAvail;π if Check(XMSResult, 'XMS_MemAvail') = xmsrOk thenπ WriteLn('Free XMS memory available: ', Memory, ' KB')π elseπ if XMSResult = xmsrNoMoreMem then Halt(xmsrNoMoreMem);π Memory := XMS_MaxAvail;π if Check(XMSResult, 'XMS_MaxAvail') = xmsrOk thenπ WriteLn('Largest XMS memory block: ', Memory, ' KB');ππ WriteLn;π if HMAAvailable thenπ if Check(XMS_AllocHMA($FFFF), 'XMS_AllocHMA') = xmsrOk thenπ beginπ WriteLn('HMA: Block allocated');π if Check(XMS_FreeHMA, 'XMS_FreeHMA') = xmsrOk thenπ WriteLn('HMA: Block released')π end;ππ Wait4Return;ππ WriteLn('XMS data transfer test'#10);π WriteLn('Message1: ', Message1);π WriteLn('Message2: ', Message2);ππ Handle := XMS_AllocEMB(1);π if Check(XMSResult, 'XMS_AllocEMB') = xmsrOk thenπ beginπ WriteLn('1 KB EMB allocated. Handle number: ', Hex(Handle, 4), 'h');π { Now copy our little Message1 to extended memory }π if Check(XMS_MoveToEMB(Handle, Message1, SizeOf(TMsg)),π 'XMS_MoveToEMB') = xmsrOk then WriteLn('Transfer to XMS: OK');π { Now copy it back to the second string }π if Check(XMS_MoveFromEMB(Handle, Message2, SizeOf(TMsg)),π 'XMS_MoveFromEMB') = xmsrOk then WriteLn('Transfer from XMS: OK');π WriteLn('Message1: ', Message1);π WriteLn('Message2: ', Message2);π WriteLn;π if Check(XMS_ReallocEMB(Handle, 2),π 'XMS_ReallocEMB') = xmsrOk thenπ WriteLn('EMB reallocated. New size: 2 KB');π WriteLn;π Address := XMS_LockEMB(Handle);π if Check(XMSResult, 'XMS_LockEMB') = xmsrOk thenπ WriteLn('EMB locked at linear memory address ',π Hex(Longint(Address), 8), 'h');ππ WriteLn;π FreeHandles := XMS_EMBHandlesAvail(Handle);π if Check(XMSResult, 'XMS_EMBHandlesAvail') = xmsrOk thenπ WriteLn('EMB Handles available: ', FreeHandles);π Locks := XMS_EMBLockCount(Handle);π if Check(XMSResult, 'XMS_EMBLockCount') = xmsrOk thenπ WriteLn('EMB Lock count: ', Locks);π BlockLength := XMS_EMBSize(Handle);π if Check(XMSResult, 'XMS_EMBSize') = xmsrOk thenπ WriteLn('EMB Length: ', BlockLength, ' KB');ππ WriteLn;π if Check(XMS_UnlockEMB(Handle), 'XMS_UnlockEMB') = xmsrOk thenπ WriteLn('EMB unlocked');ππ WriteLn;π if Check(XMS_FreeEMB(Handle), 'XMS_FreeEMB') = xmsrOk thenπ WriteLn('EMB released');ππ Wait4Returnπ end;ππ UMB := XMS_AllocUMB($FFFF);π if Check(XMSResult, 'XMS_AllocUMB') = xmsrOk thenπ beginπ WriteLn('UMB allocated at segment base ',π Hex(TUMBAllocRec(UMB).SegAddr, 4), 'h');π WriteLn('Actual size: ', TUMBAllocRec(UMB).Size, ' paragraphs'#10);π if Check(XMS_FreeUMB(TUMBAllocRec(UMB).SegAddr),π 'XMS_FreeUMB') = xmsrOk then WriteLn('UMB released')π end;π end else WriteLn('XMS not present.')πEnd.π 11 08-25-9409:07ALL RAPHAEL VANNEY PROTECTED MODE Stuff SWAG9408 à_£░ 30 ä▒ {π SM> I have a bit of a problem with pascal 7 protected mode,π SM> I have a TSR (assembly) that does my comms work for me.π SM> I use intr(regs) with various settings to the registers to collectπ SM> data from the TSR. However when in protected mode my TSR seemsπ SM> to be unavailable.ππ SM> Do I need to switch to real mode from the app.π SM> (if so how, I can't find it in the manual).ππYes. This is not documented in the manual, though.ππ SM> Do I need to modify my TSR.π SM> I presume not because I'm sure that the mouse drivers can be gotπ SM> to work.ππThe problem is that interrupt calls in protected mode useπprotected mode interrupt handlers. RTM.EXE converts protectedπmode interrupts to real mode ones, for 'known' interruptsπ(ie INT $21, some functions of INT $10, INT $33 (mouse)...)ππWhat you need is to call the DPMI function that lets you issueπa real mode interrupt. What follows should help you (let me knowπif it's not clear enough;-))π}ππ{ DPMI tools }ππ{$X+,G+}ππ{$IfNDef DPMI}π You don't need that.π{$EndIf}ππUnit MinDPMI;ππInterfaceππType TRealModeRegs =π Recordπ Case Integer Ofπ 0: ( EDI, ESI, EBP, EXX, EBX, EDX, ECX, EAX: Longint;π Flags, ES, DS, FS, GS, IP, CS, SP, SS: Word);π 1: ( DI,DIH, SI, SIH, BP, BPH, XX, XXH: Word;π Case Integer ofπ 0: (BX, BXH, DX, DXH, CX, CXH, AX, AXH: Word);π 1: (BL, BH, BLH, BHH, DL, DH, DLH, DHH,π CL, CH, CLH, CHH, AL, AH, ALH, AHH: Byte));π End;ππ TLowMemoryBlock =π Recordπ ProtectedPtr : Pointer;π RealSegment : Word;π Size : Word;π End;ππProcedure ClearRegs(Var RealRegs : TRealModeRegs);ππFunction RealModeInt( IntNo : Byte;π Var RealRegs : TRealModeRegs) : Boolean;π{ IMPORTANT notes :π - If SS and SP in RealRegs are set to 0, the DPMI server providesπ a 30 bytes stack. If not, the specified stack is used. }ππProcedure AllocateLowMem(Var Pt : TLowMemoryBlock; Size : Word);πProcedure FreeLowMem(Var Pt : TLowMemoryBlock);ππProcedure SetProtectedIntVec(No : Byte; p : Pointer);πProcedure GetProtectedIntVec(No : Byte; Var p : Pointer);ππImplementationππUses WinAPI;ππType TDouble =π Recordπ Lo, Hi : Word;π End;ππProcedure ClearRegs;πBeginπ FillChar(RealRegs, SizeOf(RealRegs), 0);πEnd;ππFunction RealModeInt( IntNo : Byte;π Var RealRegs : TRealModeRegs) : Boolean;πAssembler;πAsmπ Mov AX, $0300π Mov BL, IntNoπ XOr BH, BHπ XOr CX, CXπ LES DI, RealRegsπ Int $31π Mov AX, 0 { Not XOr }π JNC @Okπ Inc AXπ@Ok:π Or AX, AXπEnd;ππProcedure AllocateLowMem;πVar Adr : LongInt;πBeginπ Adr:=GlobalDOSAlloc(Size);π If Adr=0 Then Size:=0;π Pt.ProtectedPtr:=Ptr(TDouble(Adr).Lo, 0);π Pt.RealSegment:=TDouble(Adr).Hi;π Pt.Size:=Size;πEnd;ππProcedure FreeLowMem;πBeginπ GlobalDOSFree(Seg(Pt.ProtectedPtr^));π FillChar(Pt, SizeOf(Pt), 0); { Fills with NIL }πEnd;ππProcedure SetProtectedIntVec(No : Byte; p : Pointer); Assembler;πAsmπ Mov AX, $0205π Mov BL, Noπ Mov CX, TDouble[p].Hi { Selector }π Mov DX, TDouble[p].Lo { Offset }π Int $31πEnd;ππProcedure GetProtectedIntVec(No : Byte; Var p : Pointer); Assembler;πAsmπ Mov AX, $0204π Mov BL, Noπ Int $31π LES DI, pπ { Mov ES:[DI], DX }π { Mov ES:[DI+2], CX }π Mov TDouble[ES:DI].Lo, DXπ Mov TDouble[ES:DI].Hi, CXπEnd;ππEnd.π 12 08-26-9407:26ALL RAPHAEL VANNEY DS and ES Registers SWAG9408 ^└ï 7 ä▒ {π ET> On entry in an assembler routine, I haven't (yet?) noticed aπ ET> difference between the DS and ES registers. Can I rely on that??ππNo. You can assume ES to be uninitialized (ie, random value), andπDS pointing to the program's data segment.πTry this and see for yourself :-)ππNote that if you change "b^:=a" to "a:=b^", DS and ES hold the sameπvalue when entering ShowESAndDS.ππ}ππVar a : String ;π b : ^String ;ππProcedure ShowESAndDS ;πVar _ES,π _DS : Word ;πBeginπ Asmπ Mov _ES, ESπ Mov _DS, DSπ End ;π WriteLn('ES=', _ES, ', DS=', _DS) ;πEnd ;ππBeginπ New(b) ;π b^:=a ;π ShowESAndDS ;π Dispose(b) ;πEnd.ππ
